--- /dev/null
+/* -*-C-*-
+
+$Id: acconfig.h,v 11.1 2000/12/05 21:23:42 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*/
+
+#ifndef SCM_CONFIG_H
+#define SCM_CONFIG_H
+@TOP@
+
+/* Define if RETSIGTYPE is `void'. */
+#undef VOID_SIGNAL_HANDLERS
+
+/* Define to `short' if <sys/types.h> doesn't define. */
+#undef nlink_t
+
+/* Define to `unsigned long' if <time.h> doesn't define. */
+#undef clock_t
+
+/* Define to `long' if <time.h> doesn't define. */
+#undef time_t
+
+/* Define to `int' if <sys/socket.h> doesn't define. */
+#undef socklen_t
+
+/* Define to `unsigned char' if <termios.h> doesn't define. */
+#undef cc_t
+
+/* Define if `struct ltchars' is defined in <bsdtty.h>. */
+#undef HAVE_STRUCT_LTCHARS
+
+/* Define if `struct sigcontext' is defined in <signal.h>. */
+#undef HAVE_STRUCT_SIGCONTEXT
+
+/* Define if `struct hostent' has the `h_addr_list' member. */
+#undef HAVE_HOSTENT_H_ADDR_LIST
+
+/* Define if `struct tm' has the `tm_gmtoff' member. */
+#undef HAVE_TM_GMTOFF
+
+/* Define to name of `tm_gmtoff' member if HAVE_TM_GMTOFF defined. */
+#undef TM_GMTOFF
+
+/* Define if global timezone variable is available. */
+#undef HAVE_TIMEZONE
+
+/* Define to name of global timezone variable if HAVE_TIMEZONE defined. */
+#undef TIMEZONE
+
+/* Define if architecture has native-code compiler support. */
+#undef HAS_COMPILER_SUPPORT
+
+/* Define if blowfish library is present. */
+#undef HAVE_LIBBLOWFISH
+
+/* Define if curses library is present. */
+#undef HAVE_LIBCURSES
+
+/* Define if dl library is present. */
+#undef HAVE_LIBDL
+
+/* Define if gdbm library is present. */
+#undef HAVE_LIBGDBM
+
+/* Define if md5 library is present. */
+#undef HAVE_LIBMD5
+
+/* Define if mhash library is present. */
+#undef HAVE_LIBMHASH
+
+/* Define if ncurses library is present. */
+#undef HAVE_LIBNCURSES
+
+/* Define if termcap library is present. */
+#undef HAVE_LIBTERMCAP
+
+@BOTTOM@
+
+#ifndef __unix__
+# define __unix__
+#endif
+
+#if defined(_IRIX) || defined(_IRIX4) || defined(_IRIX6)
+# define __IRIX__
+#endif
+
+#if defined(__hpux) || defined(hpux)
+# define __HPUX__
+#endif
+
+/* If we're running under GNU libc, turn on all the features.
+ Otherwise this should be harmless. */
+#define _GNU_SOURCE
+
+#include <sys/types.h>
+
+#ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# ifdef HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif
+
+#ifdef HAVE_TERMIOS_H
+# include <termios.h>
+#else
+# ifdef HAVE_TERMIO_H
+# include <termio.h>
+# endif
+#endif
+
+/* Include the shared configuration header. */
+#include "confshared.h"
+
+#endif /* SCM_CONFIG_H */
/* Copyright (C) 1990 Free Software Foundation, Inc.
This file is part of the GNU C Library.
-$Id: ansidecl.h,v 1.6 1998/04/14 05:10:54 cph Exp $
+$Id: ansidecl.h,v 1.7 2000/12/05 21:23:42 cph Exp $
The GNU C Library is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
/* ANSI and traditional C compatibility macros
- ANSI C is assumed if __STDC__ is #defined.
+ ANSI C is assumed if STDC_HEADERS is #defined.
Macros
PTR - Generic pointer type
*/
#ifndef _ANSIDECL_H
-
#define _ANSIDECL_H 1
so they will all get the switch for lint. */
/* LINTLIBRARY */
-/* Some other compilers, specifically the Windows and OS/2 compilers,
- define __STDC__ only when the compiler is put into "strict ANSI"
- mode, in which numerous useful features are disabled. So we have
- reconditionalized these macros so that the stdc bindings can be
- used for those compilers. */
-
-#ifdef __STDC__
-#define USE_STDC_BINDINGS
-#endif
-
-#ifdef __IBMC__
-#define USE_STDC_BINDINGS
-#endif
-
-#ifdef CL386
-#define USE_STDC_BINDINGS
-#endif
-
-#ifdef _MSC_VER
-#define USE_STDC_BINDINGS
-#endif
-
-#ifdef USE_STDC_BINDINGS
+#if defined(__STDC__) || defined(STDC_HEADERS)
+#define HAVE_STDC
#define PTR void *
#define PTRCONST void *CONST
#define DEFUN(name, arglist, args) name(args)
#define DEFUN_VOID(name) name(NOARGS)
-#else /* not USE_STDC_BINDINGS */
+#else /* not (__STDC__ || STDC_HEADERS) */
#define PTR char *
#define PTRCONST PTR
#define DEFUN(name, arglist, args) name arglist args;
#define DEFUN_VOID(name) name()
-#endif /* not USE_STDC_BINDINGS */
+#endif /* not (__STDC__ || STDC_HEADERS) */
-#endif /* ansidecl.h */
+#endif /* _ANSIDECL_H */
/* -*-C-*-
-$Id: avltree.h,v 1.2 1999/01/02 06:11:34 cph Exp $
+$Id: avltree.h,v 1.3 2000/12/05 21:23:42 cph Exp $
-Copyright (c) 1993, 1999 Massachusetts Institute of Technology
+Copyright (c) 1993, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
names to indices into various tables.
*/
-#include "ansidecl.h"
+#include "config.h"
extern char * tree_error_message;
extern char * tree_error_noise;
/* -*-C-*-
-$Id: bchdmp.c,v 9.85 2000/01/18 05:06:26 cph Exp $
+$Id: bchdmp.c,v 9.86 2000/12/05 21:23:42 cph Exp $
Copyright (c) 1987-2000 Massachusetts Institute of Technology
#include "lookup.h" /* UNCOMPILED_VARIABLE */
#define In_Fasdump
#include "fasl.h"
-\f
-#ifdef DOS386
-# include "msdos.h"
-# include "dosio.h"
-
-char *
-DEFUN (mktemp, (fname), unsigned char * fname)
-{
- /* This assumes that fname ends in at least 3 Xs.
- tmpname seems too random to use.
- This, of course, has a window in which another program can
- create the file.
- */
-
- int posn = ((strlen (fname)) - 3);
- int counter;
-
- for (counter = 0; counter < 1000; counter++)
- {
- sprintf (&fname[posn], "%03d", counter);
- if ((access (fname, F_OK)) != 0)
- {
- int fid = (open (fname,
- (O_CREAT | O_EXCL | O_RDWR),
- (S_IREAD | S_IWRITE)));
- if (fid < 0)
- continue;
- close (fid);
- break;
- }
- }
- if (counter >= 1000)
- return ((char *) NULL);
+#include "bchgcc.h"
- return ((char *) fname);
-}
+extern int EXFUN (OS_channel_copy, (off_t, Tchannel, Tchannel));
-# define FASDUMP_FILENAME_DEFINED
-static char FASDUMP_FILENAME[] = "\\tmp\\faXXXXXX";
+extern SCHEME_OBJECT EXFUN
+ (dump_renumber_primitive, (SCHEME_OBJECT));
+extern SCHEME_OBJECT * EXFUN
+ (initialize_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *));
+extern SCHEME_OBJECT * EXFUN
+ (cons_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
+extern SCHEME_OBJECT * EXFUN
+ (cons_whole_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
-#endif /* DOS386 */
+extern SCHEME_OBJECT compiler_utilities;
+extern SCHEME_OBJECT * EXFUN
+ (cons_c_code_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
+\f
+#ifdef __unix__
+# include "ux.h"
+# include "uxio.h"
+ static char FASDUMP_FILENAME[] = "fasdumpXXXXXX";
+#endif
-#ifdef WINNT
+#ifdef __WIN32__
# include "nt.h"
# include "ntio.h"
+ static char FASDUMP_FILENAME[] = "faXXXXXX";
+#endif
-# define FASDUMP_FILENAME_DEFINED
-static char FASDUMP_FILENAME[] = "\\tmp\\faXXXXXX";
-
-#endif /* WINNT */
-
-#ifdef _OS2
-
-#include "os2.h"
-#define FASDUMP_FILENAME_DEFINED
-static char FASDUMP_FILENAME[] = "\\tmp\\faXXXXXX";
-
-#ifdef __EMX__
-#include <io.h>
+#ifdef __OS2__
+# include "os2.h"
+ static char FASDUMP_FILENAME[] = "faXXXXXX";
#endif
+\f
+static Tchannel dump_channel;
+static CONST char * dump_file_name;
+static int real_gc_file;
+static int dump_file;
+static SCHEME_OBJECT * saved_free;
+static SCHEME_OBJECT * fixup_buffer = 0;
+static SCHEME_OBJECT * fixup_buffer_end;
+static SCHEME_OBJECT * fixup;
+static int fixup_count = 0;
+static Boolean compiled_code_present_p;
-#endif /* _OS2 */
+#define Write_Data(size, buffer) \
+ ((OS_channel_write_dump_file \
+ (dump_channel, \
+ ((char *) (buffer)), \
+ ((size) * (sizeof (SCHEME_OBJECT))))) \
+ / (sizeof (SCHEME_OBJECT)))
-#if defined(__IBMC__) || defined(__WATCOMC__)
+#include "dump.c"
-#include <io.h>
-#include <sys\stat.h>
-#include <fcntl.h>
+static SCHEME_OBJECT EXFUN (dump_to_file, (SCHEME_OBJECT, CONST char *));
+static int EXFUN (fasdump_exit, (long length));
+static int EXFUN (reset_fixes, (void));
+static ssize_t EXFUN (eta_read, (int, char *, int));
+static ssize_t EXFUN (eta_write, (int, char *, int));
+static long EXFUN
+ (dump_loop, (SCHEME_OBJECT *, SCHEME_OBJECT **, SCHEME_OBJECT **));
+\f
+/* (PRIMITIVE-FASDUMP object-to-dump filename-or-channel flag)
-#ifndef F_OK
-#define F_OK 0
-#define X_OK 1
-#define W_OK 2
-#define R_OK 4
-#endif
+ Dump an object into a file so that it can be loaded using
+ BINARY-FASLOAD. A spare heap is required for this operation. The
+ first argument is the object to be dumped. The second is the
+ filename or channel. The third argument, FLAG, is currently
+ ignored. The primitive returns #T or #F indicating whether it
+ successfully dumped the object (it can fail on an object that is
+ too large). It should signal an error rather than return false,
+ but ... some other time.
-char *
-DEFUN (mktemp, (fname), unsigned char * fname)
-{
- /* This assumes that fname ends in at least 3 Xs.
- tmpname seems too random to use.
- This, of course, has a window in which another program can
- create the file.
- */
+ This version of fasdump can only handle files (actually lseek-able
+ streams), since the header is written at the beginning of the
+ output but its contents are only know after the rest of the output
+ has been written.
- int posn = ((strlen (fname)) - 3);
- int counter;
+ Thus, for arbitrary channels, a temporary file is allocated, and on
+ completion, the file is copied to the channel. */
- for (counter = 0; counter < 1000; counter++)
+DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0)
+{
+ PRIMITIVE_HEADER (3);
{
- sprintf (&fname[posn], "%03d", counter);
- if ((access (fname, F_OK)) != 0)
+ SCHEME_OBJECT root = (ARG_REF (1));
+ if (STRING_P (ARG_REF (2)))
+ PRIMITIVE_RETURN (dump_to_file (root, (STRING_ARG (2))));
{
- int fid = (open (fname,
- (O_CREAT | O_EXCL | O_RDWR),
- (S_IREAD | S_IWRITE)));
- if (fid < 0)
- continue;
- close (fid);
- break;
+ Tchannel channel = (arg_channel (2));
+ char * temp_name = (make_gc_file_name (FASDUMP_FILENAME));
+ transaction_begin ();
+ protect_gc_file_name (temp_name);
+ if (!allocate_gc_file (temp_name))
+ signal_error_from_primitive (ERR_EXTERNAL_RETURN);
+ {
+ SCHEME_OBJECT fasdump_result = (dump_to_file (root, temp_name));
+ if (fasdump_result == SHARP_T)
+ {
+ Tchannel temp_channel = (OS_open_input_file (temp_name));
+ int copy_result
+ = (OS_channel_copy ((OS_file_length (temp_channel)),
+ temp_channel,
+ channel));
+ OS_channel_close (temp_channel);
+ OS_file_remove (temp_name);
+ transaction_commit ();
+ if (copy_result < 0)
+ signal_error_from_primitive (ERR_IO_ERROR);
+ }
+ PRIMITIVE_RETURN (fasdump_result);
+ }
}
}
- if (counter >= 1000)
- return ((char *) NULL);
-
- return ((char *) fname);
}
+\f
+/* (DUMP-BAND PROCEDURE FILE-NAME)
+ Saves all of the heap and pure space on FILE-NAME. When the
+ file is loaded back using BAND_LOAD, PROCEDURE is called with an
+ argument of #F. */
-#endif /* __IBMC__ or __WATCOMC__ */
-
-#ifndef FASDUMP_FILENAME_DEFINED
-
-/* Assume Unix */
+DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0)
+{
+ SCHEME_OBJECT * saved_free;
+ SCHEME_OBJECT * prim_table_start;
+ SCHEME_OBJECT * prim_table_end;
+ SCHEME_OBJECT * c_table_start;
+ SCHEME_OBJECT * c_table_end;
+ long prim_table_length;
+ long c_table_length;
+ int result = 0;
+ PRIMITIVE_HEADER (2);
-# include "ux.h"
-# include "uxio.h"
-extern int EXFUN (unlink, (CONST char *));
+ Band_Dump_Permitted ();
+ CHECK_ARG (1, INTERPRETER_APPLICABLE_P);
+ CHECK_ARG (2, STRING_P);
+ if (Unused_Heap_Bottom < Heap_Bottom)
+ /* Cause the image to be in the low heap, to increase
+ the probability that no relocation is needed on reload. */
+ Primitive_GC (0);
+ Primitive_GC_If_Needed (5);
-# define FASDUMP_FILENAME_DEFINED
-static char FASDUMP_FILENAME[] = "/tmp/fasdumpXXXXXX";
+ saved_free = Free;
-#endif /* FASDUMP_FILENAME_DEFINED */
-\f
-#include "bchgcc.h"
+ {
+ SCHEME_OBJECT Combination;
+ Combination = (MAKE_POINTER_OBJECT (TC_COMBINATION_1, Free));
+ (Free[COMB_1_FN]) = (ARG_REF (1));
+ (Free[COMB_1_ARG_1]) = SHARP_F;
+ Free += 2;
+ {
+ SCHEME_OBJECT p = (MAKE_POINTER_OBJECT (TC_LIST, Free));
+ (*Free++) = Combination;
+ (*Free++) = compiler_utilities;
+ (*Free++) = p;
+ }
+ }
-static Tchannel dump_channel;
+ prim_table_start = Free;
+ prim_table_end
+ = (cons_whole_primitive_table (prim_table_start, Heap_Top,
+ (&prim_table_length)));
+ if (prim_table_end >= Heap_Top)
+ goto done;
-#define Write_Data(size, buffer) \
- ((OS_channel_write_dump_file \
- (dump_channel, \
- ((char *) (buffer)), \
- ((size) * (sizeof (SCHEME_OBJECT))))) \
- / (sizeof (SCHEME_OBJECT)))
+ c_table_start = prim_table_end;
+ c_table_end
+ = (cons_c_code_table (c_table_start, Heap_Top,
+ (&c_table_length)));
+ if (c_table_end >= Heap_Top)
+ goto done;
-#include "dump.c"
+ {
+ CONST char * filename = ((CONST char *) (STRING_LOC ((ARG_REF (2)), 0)));
+ SCHEME_OBJECT * faligned_heap = Heap_Bottom;
+ SCHEME_OBJECT * faligned_constant = Constant_Space;
-extern SCHEME_OBJECT
- EXFUN (dump_renumber_primitive, (SCHEME_OBJECT)),
- * EXFUN (initialize_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *)),
- * EXFUN (cons_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)),
- * EXFUN (cons_whole_primitive_table,
- (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
-
-static char *dump_file_name;
-static int real_gc_file, dump_file;
-static SCHEME_OBJECT *saved_free;
-static SCHEME_OBJECT *fixup_buffer = ((SCHEME_OBJECT *) NULL);
-static SCHEME_OBJECT *fixup_buffer_end;
-static SCHEME_OBJECT *fixup;
-static int fixup_count = 0;
-static Boolean compiled_code_present_p;
-\f
-/* Utility macros. */
+ BCH_ALIGN_FLOAT_ADDRESS (faligned_heap);
+ BCH_ALIGN_FLOAT_ADDRESS (faligned_constant);
-#define fasdump_remember_to_fix(location, contents) \
-{ \
- if ((fixup == fixup_buffer) && (!(reset_fixes ()))) \
- return (PRIM_INTERRUPT); \
- *--fixup = contents; \
- *--fixup = ((SCHEME_OBJECT) location); \
-}
+ OS_file_remove_link (filename);
+ dump_channel = (OS_open_dump_file (filename));
+ if (dump_channel == NO_CHANNEL)
+ error_bad_range_arg (2);
-#define fasdump_normal_setup() \
-{ \
- Old = (OBJECT_ADDRESS (Temp)); \
- if (BROKEN_HEART_P (* Old)) \
- { \
- (* Scan) = (MAKE_OBJECT_FROM_OBJECTS (Temp, (* Old))); \
- continue; \
- } \
- New_Address = (MAKE_BROKEN_HEART (To_Address)); \
- fasdump_remember_to_fix (Old, *Old); \
-}
+ result
+ = (Write_File ((Free - 1),
+ ((long) (Free - faligned_heap)),
+ faligned_heap,
+ ((long) (Free_Constant - faligned_constant)),
+ faligned_constant,
+ prim_table_start,
+ prim_table_length,
+ ((long) (prim_table_end - prim_table_start)),
+ c_table_start,
+ c_table_length,
+ ((long) (c_table_end - c_table_start)),
+ (compiler_utilities != SHARP_F),
+ 1));
-#ifdef FLOATING_ALIGNMENT
+ OS_channel_close_noerror (dump_channel);
+ if (!result)
+ OS_file_remove (filename);
+ }
-#define fasdump_flonum_setup() \
-{ \
- Old = (OBJECT_ADDRESS (Temp)); \
- if (BROKEN_HEART_P (* Old)) \
- { \
- (* Scan) = (MAKE_OBJECT_FROM_OBJECTS (Temp, (* Old))); \
- continue; \
- } \
- FLOAT_ALIGN_FREE (To_Address, To); \
- New_Address = (MAKE_BROKEN_HEART (To_Address)); \
- fasdump_remember_to_fix (Old, (* Old)); \
+ done:
+ Band_Dump_Exit_Hook ();
+ Free = saved_free;
+ PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (result));
}
+\f
+static SCHEME_OBJECT
+DEFUN (dump_to_file, (root, fname),
+ SCHEME_OBJECT root AND
+ CONST char * fname)
+{
+ Boolean success = 1;
+ long value;
+ long length;
+ long hlength;
+ long tlength;
+ long tsize;
+ SCHEME_OBJECT * dumped_object;
+ SCHEME_OBJECT * free_buffer;
+ SCHEME_OBJECT * dummy;
+ SCHEME_OBJECT * table_start;
+ SCHEME_OBJECT * table_end;
+ SCHEME_OBJECT * table_top;
+ SCHEME_OBJECT header [FASL_HEADER_LENGTH];
+
+ if (fixup_buffer == 0)
+ {
+ fixup_buffer = ((SCHEME_OBJECT *) (malloc (gc_buffer_bytes)));
+ if (fixup_buffer == 0)
+ error_system_call (errno, syscall_malloc);
+ fixup_buffer_end = (fixup_buffer + gc_buffer_size);
+ }
-#else /* FLOATING_ALIGNMENT */
-
-#define fasdump_flonum_setup() fasdump_normal_setup ()
+ dump_file_name = fname;
+ dump_file = (open (dump_file_name, GC_FILE_FLAGS, 0666));
+ if (dump_file < 0)
+ error_bad_range_arg (2);
-#endif /* FLOATING_ALIGNMENT */
+ compiled_code_present_p = 0;
+ real_gc_file = (swap_gc_file (dump_file));
+ saved_free = Free;
+ fixup = fixup_buffer_end;
+ fixup_count = -1;
-#define fasdump_transport_end(length) \
-{ \
- To_Address += (length); \
- if (To >= free_buffer_top) \
- { \
- To = (dump_and_reset_free_buffer ((To - free_buffer_top), \
- &success)); \
- if (! success) \
- return (PRIM_INTERRUPT); \
- } \
-}
+ table_top = (& (saved_free [Space_Before_GC ()]));
+ table_start = (initialize_primitive_table (saved_free, table_top));
+ if (table_start >= table_top)
+ {
+ fasdump_exit (0);
+ Primitive_GC (table_start - saved_free);
+ }
-#define fasdump_normal_transport(copy_code, length) \
-{ \
- copy_code; \
- fasdump_transport_end (length); \
-}
+ free_buffer = (initialize_free_buffer ());
+ Free = 0;
+ free_buffer += FASL_HEADER_LENGTH;
-#define fasdump_normal_end() \
-{ \
- (* (OBJECT_ADDRESS (Temp))) = New_Address; \
- (* Scan) = (MAKE_OBJECT_FROM_OBJECTS (Temp, New_Address)); \
- continue; \
-}
+ dummy = free_buffer;
+ BCH_ALIGN_FLOAT (Free, dummy);
-#define fasdump_normal_pointer(copy_code, length) \
-{ \
- fasdump_normal_setup (); \
- fasdump_normal_transport (copy_code, length); \
- fasdump_normal_end (); \
-}
-\f
-#define fasdump_typeless_setup() \
-{ \
- Old = (SCHEME_ADDR_TO_ADDR (Temp)); \
- if (BROKEN_HEART_P (* Old)) \
- { \
- (* Scan) = (ADDR_TO_SCHEME_ADDR (OBJECT_ADDRESS (* Old))); \
- continue; \
- } \
- New_Address = ((SCHEME_OBJECT) To_Address); \
- fasdump_remember_to_fix (Old, (* Old)); \
-}
+ (*free_buffer++) = root;
+ dumped_object = (Free++);
-#define fasdump_typeless_end() \
-{ \
- (* (SCHEME_ADDR_TO_ADDR (Temp))) \
- = (MAKE_BROKEN_HEART ((SCHEME_OBJECT *) New_Address)); \
- (* Scan) = (ADDR_TO_SCHEME_ADDR (New_Address)); \
- continue; \
-}
+ value
+ = dump_loop (((initialize_scan_buffer (0)) + FASL_HEADER_LENGTH),
+ (&free_buffer), (&Free));
+ if (value != PRIM_DONE)
+ {
+ fasdump_exit (0);
+ if (value == PRIM_INTERRUPT)
+ return (SHARP_F);
+ else
+ signal_error_from_primitive (value);
+ }
+ end_transport (&success);
+ if (!success)
+ {
+ fasdump_exit (0);
+ return (SHARP_F);
+ }
-#define fasdump_typeless_pointer(copy_code, length) \
-{ \
- fasdump_typeless_setup (); \
- fasdump_normal_transport (copy_code, length); \
- fasdump_typeless_end (); \
-}
+ length = (Free - dumped_object);
-#define fasdump_compiled_entry() do \
-{ \
- compiled_code_present_p = true; \
- Old = (OBJECT_ADDRESS (Temp)); \
- Compiled_BH (false, continue); \
- { \
- SCHEME_OBJECT * Saved_Old = Old; \
- \
- fasdump_remember_to_fix (Old, (* Old)); \
- FLOAT_ALIGN_FREE (To_Address, To); \
- New_Address = (MAKE_BROKEN_HEART (To_Address)); \
- copy_vector (&success); \
- if (!success) \
- return (PRIM_INTERRUPT); \
- (* Saved_Old) = New_Address; \
- Temp = RELOCATE_COMPILED (Temp, (OBJECT_ADDRESS (New_Address)), \
- Saved_Old); \
- continue; \
- } \
-} while (0)
+ table_end = (cons_primitive_table (table_start, table_top, &tlength));
+ if (table_end >= table_top)
+ {
+ fasdump_exit (0);
+ Primitive_GC (table_end - saved_free);
+ }
-#define fasdump_linked_operator() do \
-{ \
- Scan = ((SCHEME_OBJECT *) (word_ptr)); \
- BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
- fasdump_compiled_entry (); \
- BCH_STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
-} while (0)
+#ifdef NATIVE_CODE_IS_C
+ /* Cannot dump C compiled code. */
+ if (compiled_code_present_p)
+ {
+ fasdump_exit (0);
+ signal_error_from_primitive (ERR_COMPILED_CODE_ERROR);
+ }
+#endif
-#define fasdump_manifest_closure() do \
-{ \
- Scan = ((SCHEME_OBJECT *) (word_ptr)); \
- BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
- fasdump_compiled_entry (); \
- BCH_STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
-} while (0)
-\f
-int
-DEFUN (eta_read, (fid, buffer, size),
- int fid AND char * buffer AND int size)
-{
- return (read (fid, buffer, size));
-}
+ tsize = (table_end - table_start);
+ hlength = ((sizeof (SCHEME_OBJECT)) * tsize);
+ if (((lseek (dump_file,
+ ((sizeof (SCHEME_OBJECT)) * (length + FASL_HEADER_LENGTH)),
+ 0))
+ == -1)
+ || ((write (dump_file, ((char *) (&table_start[0])), hlength))
+ != hlength))
+ {
+ fasdump_exit (0);
+ return (SHARP_F);
+ }
-int
-DEFUN (eta_write, (fid, buffer, size),
- int fid AND char * buffer AND int size)
-{
- return (write (fid, buffer, size));
+ hlength = ((sizeof (SCHEME_OBJECT)) * FASL_HEADER_LENGTH);
+ prepare_dump_header
+ (header, dumped_object, length, dumped_object,
+ 0, Constant_Space, tlength, tsize, 0, 0,
+ compiled_code_present_p, 0);
+ if (((lseek (dump_file, 0, 0)) == -1)
+ || ((write (dump_file, ((char *) &header[0]), hlength)) != hlength))
+ {
+ fasdump_exit (0);
+ return (SHARP_F);
+ }
+ return
+ (BOOLEAN_TO_OBJECT
+ (fasdump_exit (((sizeof (SCHEME_OBJECT)) * (length + tsize)) + hlength)));
}
-
-Boolean
+\f
+static int
DEFUN (fasdump_exit, (length), long length)
{
- fast SCHEME_OBJECT * fixes, * fix_address;
- Boolean result;
+ SCHEME_OBJECT * fixes, * fix_address;
+ int result;
Free = saved_free;
restore_gc_file ();
#ifdef HAVE_FTRUNCATE
- {
-#if (! (defined(_HPUX) || defined(__linux)))
- /* HP-UX version < 9.0 has the wrong type in the prototype
- in <unistd.h>
- */
-
- extern int EXFUN (ftruncate, (int, off_t));
+ ftruncate (dump_file, length);
#endif
-
- ftruncate (dump_file, length);
- result = ((close (dump_file)) == 0);
- }
-#else
-
- result = (close (dump_file) == 0);
-
-#endif /* HAVE_FTRUNCATE */
+ result = ((close (dump_file)) == 0);
#if defined(HAVE_TRUNCATE) && !defined(HAVE_FTRUNCATE)
- {
-#ifndef _HPUX
- /* HP-UX version < 9.0 has the wrong type in the prototype
- in <unistd.h>
- */
-
- extern int EXFUN (truncate, (CONST char *, off_t));
+ truncate (dump_file_name, length);
#endif
- truncate (dump_file_name, length);
- }
-#endif /* HAVE_TRUNCATE */
-
if (length == 0)
- (void) (unlink (dump_file_name));
- dump_file_name = ((char *) NULL);
+ unlink (dump_file_name);
+ dump_file_name = 0;
fixes = fixup;
-\f
-next_buffer:
+
+ next_buffer:
while (fixes != fixup_buffer_end)
- {
- fix_address = ((SCHEME_OBJECT *) (* fixes++)); /* Where it goes. */
- (* fix_address) = (* fixes++); /* Put it there. */
- }
+ {
+ fix_address = ((SCHEME_OBJECT *) (*fixes++));
+ (*fix_address) = (*fixes++);
+ }
if (fixup_count >= 0)
- {
- if ((retrying_file_operation
- (eta_read, real_gc_file, ((char *) fixup_buffer),
- (gc_file_start_position + (fixup_count << gc_buffer_byte_shift)),
- gc_buffer_bytes, "read", "the fixup buffer",
- &gc_file_current_position, io_error_retry_p))
- != ((long) gc_buffer_bytes))
{
- gc_death (TERM_EXIT,
- "fasdump: Could not read back the fasdump fixup information",
- NULL, NULL);
- /*NOTREACHED*/
+ if ((retrying_file_operation
+ (eta_read,
+ real_gc_file,
+ ((char *) fixup_buffer),
+ (gc_file_start_position + (fixup_count << gc_buffer_byte_shift)),
+ gc_buffer_bytes,
+ "read",
+ "the fixup buffer",
+ (&gc_file_current_position),
+ io_error_retry_p))
+ != ((long) gc_buffer_bytes))
+ {
+ gc_death
+ (TERM_EXIT,
+ "fasdump: Could not read back the fasdump fixup information",
+ 0, 0);
+ /*NOTREACHED*/
+ }
+ fixup_count -= 1;
+ fixes = fixup_buffer;
+ goto next_buffer;
}
- fixup_count -= 1;
- fixes = fixup_buffer;
- goto next_buffer;
- }
fixup = fixes;
Fasdump_Exit_Hook ();
return (result);
}
-
-Boolean
+\f
+static int
DEFUN_VOID (reset_fixes)
{
long start;
if (((start + ((long) gc_buffer_bytes)) > gc_file_end_position)
|| ((retrying_file_operation
- (eta_write, real_gc_file, ((char *) fixup_buffer),
- start, gc_buffer_bytes, "write", "the fixup buffer",
- &gc_file_current_position, io_error_always_abort))
+ (eta_write,
+ real_gc_file,
+ ((char *) fixup_buffer),
+ start,
+ gc_buffer_bytes,
+ "write",
+ "the fixup buffer",
+ (&gc_file_current_position),
+ io_error_always_abort))
!= ((long) gc_buffer_bytes)))
- return (false);
+ return (0);
fixup = fixup_buffer_end;
- return (true);
+ return (1);
}
-\f
-/* A copy of GCLoop, with minor modifications. */
-long
-DEFUN (dumploop, (Scan, To_ptr, To_Address_ptr),
- fast SCHEME_OBJECT * Scan AND
- SCHEME_OBJECT ** To_ptr AND
- SCHEME_OBJECT ** To_Address_ptr)
+static ssize_t
+DEFUN (eta_read, (fid, buffer, size),
+ int fid AND
+ char * buffer AND
+ int size)
{
- fast SCHEME_OBJECT * To, * Old, Temp, * To_Address, New_Address;
- Boolean success;
-
- success = true;
- To = (* To_ptr);
- To_Address = (* To_Address_ptr);
-
- for ( ; Scan != To; Scan++)
- {
- Temp = (* Scan);
- Switch_by_GC_Type (Temp)
- {
- case TC_BROKEN_HEART:
- if ((OBJECT_DATUM (Temp)) == 0)
- break;
- if (Temp != (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Scan)))
- {
- sprintf (gc_death_message_buffer,
- "purifyloop: broken heart (0x%lx) in scan",
- Temp);
- gc_death (TERM_BROKEN_HEART, gc_death_message_buffer, Scan, To);
- /*NOTREACHED*/
- }
- if (Scan != scan_buffer_top)
- goto end_dumploop;
-
- /* The -1 is here because of the Scan++ in the for header. */
+ return (read (fid, buffer, size));
+}
- Scan = ((dump_and_reload_scan_buffer (0, &success)) - 1);
- if (!success)
- return (PRIM_INTERRUPT);
- continue;
+static ssize_t
+DEFUN (eta_write, (fid, buffer, size),
+ int fid AND
+ char * buffer AND
+ int size)
+{
+ return (write (fid, buffer, size));
+}
\f
- case TC_MANIFEST_NM_VECTOR:
- case TC_MANIFEST_SPECIAL_NM_VECTOR:
- /* Check whether this bumps over current buffer,
- and if so we need a new bufferfull. */
- Scan += (OBJECT_DATUM (Temp));
-area_skipped:
- if (Scan < scan_buffer_top)
- break;
- else
- {
- unsigned long overflow;
-
- /* The + & -1 are here because of the Scan++ in the for header. */
- overflow = ((Scan - scan_buffer_top) + 1);
- Scan = (((dump_and_reload_scan_buffer ((overflow >> gc_buffer_shift),
- &success)) +
- (overflow & gc_buffer_mask)) - 1);
- if (!success)
- return (PRIM_INTERRUPT);
- break;
- }
+#define MAYBE_DUMP_FREE(free) \
+{ \
+ if (free >= free_buffer_top) \
+ DUMP_FREE (free); \
+}
- case TC_PRIMITIVE:
- case TC_PCOMB0:
- (* Scan) = (dump_renumber_primitive (* Scan));
- break;
-\f
- case_compiled_entry_point:
- fasdump_compiled_entry ();
- (* Scan) = Temp;
- break;
+#define DUMP_FREE(free) do \
+{ \
+ Boolean _s = 1; \
+ free = (dump_and_reset_free_buffer (free, (&_s))); \
+ if (!_s) \
+ return (PRIM_INTERRUPT); \
+} while (0)
- case TC_LINKAGE_SECTION:
+#define MAYBE_DUMP_SCAN(scan) \
+{ \
+ if (scan >= scan_buffer_top) \
+ DUMP_SCAN (scan); \
+}
+
+#define DUMP_SCAN(scan) do \
+{ \
+ Boolean _s = 1; \
+ scan = (dump_and_reload_scan_buffer (scan, (&_s))); \
+ if (!_s) \
+ return (PRIM_INTERRUPT); \
+} while (0)
+
+#define PUSH_FIXUP_DATA(ptr) \
+{ \
+ if ((fixup == fixup_buffer) && (!reset_fixes ())) \
+ return (PRIM_INTERRUPT); \
+ (*--fixup) = (* (ptr)); \
+ (*--fixup) = ((SCHEME_OBJECT) ptr); \
+}
+
+#define TRANSPORT_VECTOR(new_address, free, old_start, n_words) \
+{ \
+ SCHEME_OBJECT * old_ptr = old_start; \
+ SCHEME_OBJECT * free_end = (free + n_words); \
+ if (free_end < free_buffer_top) \
+ while (free < free_end) \
+ (*free++) = (*old_ptr++); \
+ else \
+ { \
+ while (free < free_buffer_top) \
+ (*free++) = (*old_ptr++); \
+ free = (transport_vector_tail (free, free_end, old_ptr)); \
+ if (free == 0) \
+ return (PRIM_INTERRUPT); \
+ } \
+}
+
+static SCHEME_OBJECT *
+DEFUN (transport_vector_tail, (free, free_end, tail),
+ SCHEME_OBJECT * free AND
+ SCHEME_OBJECT * free_end AND
+ SCHEME_OBJECT * tail)
+{
+ unsigned long n_words = (free_end - free);
+ {
+ Boolean success = 1;
+ free = (dump_and_reset_free_buffer (free, (&success)));
+ if (!success)
+ return (0);
+ }
+ {
+ unsigned long n_blocks = (n_words >> gc_buffer_shift);
+ if (n_blocks > 0)
{
- switch (READ_LINKAGE_KIND (Temp))
+ Boolean success = 1;
+ free = (dump_free_directly (tail, n_blocks, (&success)));
+ if (!success)
+ return (0);
+ tail += (n_blocks << gc_buffer_shift);
+ }
+ }
+ {
+ SCHEME_OBJECT * free_end = (free + (n_words & gc_buffer_mask));
+ while (free < free_end)
+ (*free++) = (*tail++);
+ }
+ return (free);
+}
+\f
+/* A copy of gc_loop, with minor modifications. */
+
+static long
+DEFUN (dump_loop, (scan, free_ptr, new_address_ptr),
+ SCHEME_OBJECT * scan AND
+ SCHEME_OBJECT ** free_ptr AND
+ SCHEME_OBJECT ** new_address_ptr)
+{
+ SCHEME_OBJECT * free = (*free_ptr);
+ SCHEME_OBJECT * new_address = (*new_address_ptr);
+ while (scan != free)
+ {
+ SCHEME_OBJECT object;
+ if (scan >= scan_buffer_top)
{
- case REFERENCE_LINKAGE_KIND:
- case ASSIGNMENT_LINKAGE_KIND:
- {
- /* count typeless pointers to quads follow. */
+ if (scan == scan_buffer_top)
+ DUMP_SCAN (scan);
+ else
+ {
+ sprintf
+ (gc_death_message_buffer,
+ "dump_loop: scan (0x%lx) > scan_buffer_top (0x%lx)",
+ ((unsigned long) scan),
+ ((unsigned long) scan_buffer_top));
+ gc_death (TERM_EXIT, gc_death_message_buffer, scan, free);
+ /*NOTREACHED*/
+ }
+ }
+ object = (*scan);
+ switch (OBJECT_TYPE (object))
+ {
+ case TC_BROKEN_HEART:
+ if ((OBJECT_DATUM (object)) == 0)
+ {
+ scan += 1;
+ break;
+ }
+ if (object == (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, scan)))
+ /* Does this ever happen? */
+ goto end_dump_loop;
+ sprintf (gc_death_message_buffer,
+ "dump_loop: broken heart (0x%lx) in scan",
+ object);
+ gc_death (TERM_BROKEN_HEART, gc_death_message_buffer, scan, free);
+ /*NOTREACHED*/
+ break;
- fast long count;
- long max_count, max_here;
+ case TC_CHARACTER:
+ case TC_CONSTANT:
+ case TC_FIXNUM:
+ case TC_NULL:
+ case TC_RETURN_CODE:
+ case TC_STACK_ENVIRONMENT:
+ case TC_THE_ENVIRONMENT:
+ scan += 1;
+ break;
- Scan++;
- max_here = (scan_buffer_top - Scan);
- max_count = (READ_CACHE_LINKAGE_COUNT (Temp));
- while (max_count != 0)
- {
- count = ((max_count > max_here) ? max_here : max_count);
- max_count -= count;
- for ( ; --count >= 0; Scan += 1)
+ case TC_PCOMB0:
+ case TC_PRIMITIVE:
+ (*scan++) = (dump_renumber_primitive (object));
+ break;
+
+ case TC_CELL:
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
{
- Temp = (* Scan);
- fasdump_typeless_pointer (copy_quadruple (), 4);
+ PUSH_FIXUP_DATA (old_start);
+ (*free++) = (old_start[0]);
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 1;
}
- if (max_count != 0)
+ }
+ break;
+
+ case TC_ACCESS:
+ case TC_ASSIGNMENT:
+ case TC_COMBINATION_1:
+ case TC_COMMENT:
+ case TC_COMPLEX:
+ case TC_DEFINITION:
+ case TC_DELAY:
+ case TC_DELAYED:
+ case TC_DISJUNCTION:
+ case TC_ENTITY:
+ case TC_EXTENDED_PROCEDURE:
+ case TC_INTERNED_SYMBOL:
+ case TC_IN_PACKAGE:
+ case TC_LAMBDA:
+ case TC_LEXPR:
+ case TC_LIST:
+ case TC_PCOMB1:
+ case TC_PROCEDURE:
+ case TC_RATNUM:
+ case TC_SCODE_QUOTE:
+ case TC_SEQUENCE_2:
+ case TC_UNINTERNED_SYMBOL:
+ case TC_WEAK_CONS:
+ transport_pair:
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
{
- /* We stopped because we needed to relocate too many. */
- Scan = (dump_and_reload_scan_buffer (0, NULL));
- max_here = gc_buffer_size;
+ PUSH_FIXUP_DATA (old_start);
+ (*free++) = (old_start[0]);
+ switch (OBJECT_TYPE (object))
+ {
+ case TC_INTERNED_SYMBOL:
+ (*free++) = BROKEN_HEART_ZERO;
+ break;
+ case TC_UNINTERNED_SYMBOL:
+ (*free++) = UNBOUND_OBJECT;
+ break;
+ default:
+ (*free++) = (old_start[1]);
+ break;
+ }
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 2;
}
- }
- /* The + & -1 are here because of the Scan++ in the for header. */
- Scan -= 1;
- break;
}
-\f
- case OPERATOR_LINKAGE_KIND:
- case GLOBAL_OPERATOR_LINKAGE_KIND:
- {
- /* Operator linkage */
-
- fast long count;
- fast char *word_ptr, *next_ptr;
- long overflow;
+ break;
- word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
- if (! (word_ptr > ((char *) scan_buffer_top)))
- BCH_START_OPERATOR_RELOCATION (Scan);
+ case TC_COMBINATION_2:
+ case TC_CONDITIONAL:
+ case TC_EXTENDED_LAMBDA:
+ case TC_HUNK3_A:
+ case TC_HUNK3_B:
+ case TC_PCOMB2:
+ case TC_SEQUENCE_3:
+ case TC_VARIABLE:
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
else
- {
- overflow = (word_ptr - ((char *) Scan));
- extend_scan_buffer (word_ptr, To);
- BCH_START_OPERATOR_RELOCATION (Scan);
- word_ptr = (end_scan_buffer_extension (word_ptr));
- Scan = ((SCHEME_OBJECT *) (word_ptr - overflow));
- }
-
- count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
- overflow = ((END_OPERATOR_LINKAGE_AREA (Scan, count)) -
- scan_buffer_top);
-
- for (next_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr));
- (--count >= 0);
- word_ptr = next_ptr,
- next_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr)))
- {
- if (! (next_ptr > ((char *) scan_buffer_top)))
- fasdump_linked_operator ();
- else
{
- extend_scan_buffer (next_ptr, To);
- fasdump_linked_operator ();
- next_ptr = (end_scan_buffer_extension (next_ptr));
- overflow -= gc_buffer_size;
+ PUSH_FIXUP_DATA (old_start);
+ (*free++) = (old_start[0]);
+ switch (OBJECT_TYPE (object))
+ {
+ case TC_VARIABLE:
+ (*free++) = UNCOMPILED_VARIABLE;
+ (*free++) = SHARP_F;
+ break;
+ default:
+ (*free++) = (old_start[1]);
+ (*free++) = (old_start[2]);
+ break;
+ }
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 3;
}
- }
- Scan = (scan_buffer_top + overflow);
- BCH_END_OPERATOR_RELOCATION (Scan);
- break;
}
+ break;
- case CLOSURE_PATTERN_LINKAGE_KIND:
- Scan += (READ_CACHE_LINKAGE_COUNT (Temp));
- goto area_skipped;
-
- default:
- gc_death (TERM_EXIT,
- "fasdump: Unknown compiler linkage kind.",
- Scan, Free);
- /*NOTREACHED*/
- }
- break;
- }
-\f
- case TC_MANIFEST_CLOSURE:
- {
- fast long count;
- fast char * word_ptr;
- char * end_ptr;
-
- Scan += 1;
-
- /* Is there enough space to read the count? */
-
- end_ptr = (((char *) Scan) + (2 * (sizeof (format_word))));
- if (end_ptr > ((char *) scan_buffer_top))
- {
- long dw;
-
- extend_scan_buffer (end_ptr, To);
- BCH_START_CLOSURE_RELOCATION (Scan - 1);
- count = (MANIFEST_CLOSURE_COUNT (Scan));
- word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
- dw = (word_ptr - end_ptr);
- end_ptr = (end_scan_buffer_extension (end_ptr));
- word_ptr = (end_ptr + dw);
- Scan = ((SCHEME_OBJECT *) (end_ptr - (2 * (sizeof (format_word)))));
- }
- else
- {
- BCH_START_CLOSURE_RELOCATION (Scan - 1);
- count = (MANIFEST_CLOSURE_COUNT (Scan));
- word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
- }
- end_ptr = ((char *) (MANIFEST_CLOSURE_END (Scan, count)));
-
- for ( ; ((--count) >= 0);
- (word_ptr = (NEXT_MANIFEST_CLOSURE_ENTRY (word_ptr))))
- {
- if (! ((CLOSURE_ENTRY_END (word_ptr)) > ((char *) scan_buffer_top)))
- fasdump_manifest_closure ();
- else
+ case TC_QUAD:
{
- char * entry_end;
- long de, dw;
-
- entry_end = (CLOSURE_ENTRY_END (word_ptr));
- de = (end_ptr - entry_end);
- dw = (entry_end - word_ptr);
- extend_scan_buffer (entry_end, To);
- fasdump_manifest_closure ();
- entry_end = (end_scan_buffer_extension (entry_end));
- word_ptr = (entry_end - dw);
- end_ptr = (entry_end + de);
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
+ {
+ PUSH_FIXUP_DATA (old_start);
+ (*free++) = (old_start[0]);
+ (*free++) = (old_start[1]);
+ (*free++) = (old_start[2]);
+ (*free++) = (old_start[3]);
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 4;
+ }
}
- }
- Scan = ((SCHEME_OBJECT *) (end_ptr));
- BCH_END_CLOSURE_RELOCATION (Scan);
- break;
- }
-\f
- case_Cell:
- fasdump_normal_pointer (copy_cell (), 1);
-
- case TC_REFERENCE_TRAP:
- if ((OBJECT_DATUM (Temp)) <= TRAP_MAX_IMMEDIATE)
- /* It is a non pointer. */
break;
- /* It is a pair, fall through. */
-
- case TC_WEAK_CONS:
- case_Fasdump_Pair:
- fasdump_normal_pointer (copy_pair (), 2);
-
- case TC_INTERNED_SYMBOL:
- {
- fasdump_normal_setup ();
- (* To++) = (* Old);
- (* To++) = BROKEN_HEART_ZERO;
- fasdump_transport_end (2);
- fasdump_normal_end ();
- }
-
- case TC_UNINTERNED_SYMBOL:
- {
- fasdump_normal_setup ();
- (* To++) = (* Old);
- (* To++) = UNBOUND_OBJECT;
- fasdump_transport_end (2);
- fasdump_normal_end ();
- }
-
- case_Triple:
- fasdump_normal_pointer (copy_triple (), 3);
-
- case TC_VARIABLE:
- {
- fasdump_normal_setup ();
- (* To++) = (* Old);
- (* To++) = UNCOMPILED_VARIABLE;
- (* To++) = SHARP_F;
- fasdump_transport_end (3);
- fasdump_normal_end ();
- }
-\f
- case_Quadruple:
- fasdump_normal_pointer (copy_quadruple (), 4);
-
- case_Aligned_Vector:
- fasdump_flonum_setup ();
- goto Move_Vector;
-
- case_Purify_Vector:
- fasdump_normal_setup ();
- Move_Vector:
- copy_vector (&success);
- if (!success)
- return (PRIM_INTERRUPT);
- fasdump_normal_end ();
-
- case TC_ENVIRONMENT:
- /* Make fasdump fail */
- return (ERR_FASDUMP_ENVIRONMENT);
-
- case TC_FUTURE:
- fasdump_normal_setup ();
- if (!(Future_Spliceable (Temp)))
- goto Move_Vector;
- (* Scan) = (Future_Value (Temp));
- Scan -= 1;
- continue;
-
- default:
- GC_BAD_TYPE ("dumploop");
- /* Fall Through */
-
- case TC_STACK_ENVIRONMENT:
- case_Fasload_Non_Pointer:
- break;
- }
- }
-
-end_dumploop:
-
- (* To_ptr) = To;
- (* To_Address_ptr) = To_Address;
- return (PRIM_DONE);
-}
-\f
-static SCHEME_OBJECT
-DEFUN (dump_to_file, (root, fname),
- SCHEME_OBJECT root AND char * fname)
-{
- Boolean success;
- long value, length, hlength, tlength, tsize;
- SCHEME_OBJECT * dumped_object, * free_buffer, * dummy;
- SCHEME_OBJECT * table_start, * table_end, * table_top;
- SCHEME_OBJECT header[FASL_HEADER_LENGTH];
-
- if (fixup_buffer == ((SCHEME_OBJECT *) NULL))
- {
- fixup_buffer = ((SCHEME_OBJECT *) (malloc (gc_buffer_bytes)));
- if (fixup_buffer == ((SCHEME_OBJECT *) NULL))
- error_system_call (errno, syscall_malloc);
- fixup_buffer_end = (fixup_buffer + gc_buffer_size);
- }
-
- dump_file_name = fname;
- dump_file = (open (dump_file_name, GC_FILE_FLAGS, 0666));
- if (dump_file < 0)
- error_bad_range_arg (2);
-
- compiled_code_present_p = false;
- success = true;
- real_gc_file = (swap_gc_file (dump_file));
- saved_free = Free;
- fixup = fixup_buffer_end;
- fixup_count = -1;
-
- table_top = (&saved_free[Space_Before_GC ()]);
- table_start = (initialize_primitive_table (saved_free, table_top));
- if (table_start >= table_top)
- {
- fasdump_exit (0);
- Primitive_GC (table_start - saved_free);
- }
-
- free_buffer = (initialize_free_buffer ());
- Free = ((SCHEME_OBJECT *) NULL);
- free_buffer += FASL_HEADER_LENGTH;
-
- dummy = free_buffer;
- FLOAT_ALIGN_FREE (Free, dummy);
-
- (* free_buffer++) = root;
- dumped_object = Free;
- Free += 1;
-\f
- value = dumploop (((initialize_scan_buffer ((SCHEME_OBJECT *) NULL))
- + FASL_HEADER_LENGTH),
- &free_buffer, &Free);
- if (value != PRIM_DONE)
- {
- fasdump_exit (0);
- if (value == PRIM_INTERRUPT)
- return (SHARP_F);
- else
- signal_error_from_primitive (value);
- }
- end_transport (&success);
- if (! success)
- {
- fasdump_exit (0);
- return (SHARP_F);
- }
-
- length = (Free - dumped_object);
-
- table_end = (cons_primitive_table (table_start, table_top, &tlength));
- if (table_end >= table_top)
- {
- fasdump_exit (0);
- Primitive_GC (table_end - saved_free);
- }
-
-#ifdef NATIVE_CODE_IS_C
- /* Cannot dump C compiled code. */
+ case TC_BIG_FIXNUM:
+ case TC_CHARACTER_STRING:
+ case TC_COMBINATION:
+ case TC_CONTROL_POINT:
+ case TC_NON_MARKED_VECTOR:
+ case TC_PCOMB3:
+ case TC_RECORD:
+ case TC_VECTOR:
+ case TC_VECTOR_16B:
+ case TC_VECTOR_1B:
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ PUSH_FIXUP_DATA (old_start);
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+ }
+ break;
- if (compiled_code_present_p)
- {
- fasdump_exit (0);
- signal_error_from_primitive (ERR_COMPILED_CODE_ERROR);
- }
+ case TC_BIG_FLONUM:
+ case TC_COMPILED_CODE_BLOCK:
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ PUSH_FIXUP_DATA (old_start);
+ BCH_ALIGN_FLOAT (new_address, free);
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+ }
+ break;
-#endif /* NATIVE_CODE_IS_C */
+ case TC_MANIFEST_NM_VECTOR:
+ case TC_MANIFEST_SPECIAL_NM_VECTOR:
+ scan += (1 + (OBJECT_DATUM (object)));
+ MAYBE_DUMP_SCAN (scan);
+ break;
- tsize = (table_end - table_start);
- hlength = ((sizeof (SCHEME_OBJECT)) * tsize);
- if (((lseek (dump_file,
- ((sizeof (SCHEME_OBJECT)) * (length + FASL_HEADER_LENGTH)),
- 0))
- == -1)
- || ((write (dump_file, ((char *) &table_start[0]), hlength)) != hlength))
- {
- fasdump_exit (0);
- return (SHARP_F);
- }
+ case TC_REFERENCE_TRAP:
+ if ((OBJECT_DATUM (object)) > TRAP_MAX_IMMEDIATE)
+ goto transport_pair;
+ /* Otherwise it's a non-pointer. */
+ scan += 1;
+ break;
- hlength = ((sizeof (SCHEME_OBJECT)) * FASL_HEADER_LENGTH);
- prepare_dump_header (header, dumped_object, length, dumped_object,
- 0, Constant_Space, tlength, tsize, 0, 0,
- compiled_code_present_p, false);
- if (((lseek (dump_file, 0, 0)) == -1)
- || ((write (dump_file, ((char *) &header[0]), hlength)) != hlength))
- {
- fasdump_exit (0);
- return (SHARP_F);
- }
- return (fasdump_exit (((sizeof (SCHEME_OBJECT)) *
- (length + tsize)) + hlength) ?
- SHARP_T : SHARP_F);
-}
-\f
-/* (PRIMITIVE-FASDUMP object-to-dump filename-or-channel flag)
+ case TC_COMPILED_ENTRY:
+ compiled_code_present_p = true;
+ {
+ SCHEME_OBJECT * old_start;
+ Get_Compiled_Block (old_start, (OBJECT_ADDRESS (object)));
+ if (BROKEN_HEART_P (*old_start))
+ (*scan++)
+ = (RELOCATE_COMPILED (object,
+ (OBJECT_ADDRESS (*old_start)),
+ old_start));
+ else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ PUSH_FIXUP_DATA (old_start);
+ BCH_ALIGN_FLOAT (new_address, free);
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ (*scan++)
+ = (RELOCATE_COMPILED (object, new_address, old_start));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+ }
+ break;
- Dump an object into a file so that it can be loaded using
- BINARY-FASLOAD. A spare heap is required for this operation. The
- first argument is the object to be dumped. The second is the
- filename or channel. The third argument, FLAG, is currently
- ignored. The primitive returns #T or #F indicating whether it
- successfully dumped the object (it can fail on an object that is
- too large). It should signal an error rather than return false,
- but ... some other time.
+ case TC_LINKAGE_SECTION:
+ switch (READ_LINKAGE_KIND (object))
+ {
+ case REFERENCE_LINKAGE_KIND:
+ case ASSIGNMENT_LINKAGE_KIND:
+ {
+ /* `count' typeless pointers to quads follow. */
+ unsigned long count = (READ_CACHE_LINKAGE_COUNT (object));
+ scan += 1;
+ while (count > 0)
+ {
+ SCHEME_OBJECT * old_start = (SCHEME_ADDR_TO_ADDR (*scan));
+ if (BROKEN_HEART_P (*old_start))
+ (*scan++)
+ = (ADDR_TO_SCHEME_ADDR (OBJECT_ADDRESS (*old_start)));
+ else
+ {
+ PUSH_FIXUP_DATA (old_start);
+ (*free++) = (old_start[0]);
+ (*free++) = (old_start[1]);
+ (*free++) = (old_start[2]);
+ (*free++) = (old_start[3]);
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (ADDR_TO_SCHEME_ADDR (new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 4;
+ }
+ MAYBE_DUMP_SCAN (scan);
+ count -= 1;
+ }
+ }
+ break;
- This version of fasdump can only handle files (actually lseek-able
- streams), since the header is written at the beginning of the
- output but its contents are only know after the rest of the output
- has been written.
+ case OPERATOR_LINKAGE_KIND:
+ case GLOBAL_OPERATOR_LINKAGE_KIND:
+ {
+ unsigned long count = (READ_OPERATOR_LINKAGE_COUNT (object));
+ char * entry = (FIRST_OPERATOR_LINKAGE_ENTRY (scan));
+ long delta;
+
+ if (count > 0)
+ compiled_code_present_p = true;
+
+ {
+ int extend_p = (entry >= ((char *) scan_buffer_top));
+ long delta1 = (((char *) scan) - entry);
+ if (extend_p)
+ extend_scan_buffer (entry, free);
+ BCH_START_OPERATOR_RELOCATION (scan);
+ if (extend_p)
+ {
+ entry = (end_scan_buffer_extension (entry));
+ scan = ((SCHEME_OBJECT *) (entry + delta1));
+ }
+ }
+
+ /* END_OPERATOR_LINKAGE_AREA assumes that we will add
+ one to the result, so do that now. */
+ delta
+ = (((END_OPERATOR_LINKAGE_AREA (scan, count)) + 1)
+ - scan_buffer_top);
+
+ /* The operator entries are copied sequentially, but
+ extra hair is required because the entry addresses
+ are encoded. */
+ while (count > 0)
+ {
+ char * next_entry = (NEXT_LINKAGE_OPERATOR_ENTRY (entry));
+ int extend_p = (next_entry >= ((char *) scan_buffer_top));
+ SCHEME_OBJECT esaddr;
+ SCHEME_OBJECT * old_start;
+
+ /* Guarantee that the scan buffer is large enough
+ to hold the entry. */
+ if (extend_p)
+ extend_scan_buffer (next_entry, free);
+
+ /* Get the entry address. */
+ BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS (esaddr, entry);
+
+ /* Get the code-block pointer for this entry. */
+ Get_Compiled_Block
+ (old_start, (SCHEME_ADDR_TO_ADDR (esaddr)));
+
+ /* Copy the block. */
+ if (BROKEN_HEART_P (*old_start))
+ {
+ BCH_STORE_OPERATOR_LINKAGE_ADDRESS
+ ((RELOCATE_COMPILED_RAW_ADDRESS
+ (esaddr,
+ (OBJECT_ADDRESS (*old_start)),
+ old_start)),
+ entry);
+ }
+ else
+ {
+ unsigned long n_words
+ = (1 + (OBJECT_DATUM (*old_start)));
+ PUSH_FIXUP_DATA (old_start);
+ BCH_ALIGN_FLOAT (new_address, free);
+ TRANSPORT_VECTOR
+ (new_address, free, old_start, n_words);
+ BCH_STORE_OPERATOR_LINKAGE_ADDRESS
+ ((RELOCATE_COMPILED_RAW_ADDRESS
+ (esaddr, new_address, old_start)),
+ entry);
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+
+ if (extend_p)
+ {
+ entry = (end_scan_buffer_extension (next_entry));
+ delta -= gc_buffer_size;
+ }
+ else
+ entry = next_entry;
+
+ count -= 1;
+ }
+ scan = (scan_buffer_top + delta);
+ MAYBE_DUMP_SCAN (scan);
+ BCH_END_OPERATOR_RELOCATION (scan);
+ }
+ break;
+
+ case CLOSURE_PATTERN_LINKAGE_KIND:
+ scan += (1 + (READ_CACHE_LINKAGE_COUNT (object)));
+ MAYBE_DUMP_SCAN (scan);
+ break;
+
+ default:
+ gc_death (TERM_EXIT, "dump_loop: Unknown compiler linkage kind.",
+ scan, free);
+ /*NOTREACHED*/
+ scan += 1;
+ break;
+ }
+ break;
- Thus, for arbitrary channels, a temporary file is allocated, and on
- completion, the file is copied to the channel.
+ case TC_MANIFEST_CLOSURE:
+ {
+ unsigned long count;
+ char * entry;
+ char * closure_end;
-*/
+ {
+ unsigned long delta = (2 * (sizeof (format_word)));
+ char * count_end = (((char *) (scan + 1)) + delta);
+ int extend_p = (count_end >= ((char *) scan_buffer_top));
+
+ /* Guarantee that the scan buffer is large enough to
+ hold the count field. */
+ if (extend_p)
+ extend_scan_buffer (count_end, free);
+
+ BCH_START_CLOSURE_RELOCATION (scan);
+ count = (MANIFEST_CLOSURE_COUNT (scan + 1));
+ entry = (FIRST_MANIFEST_CLOSURE_ENTRY (scan + 1));
+
+ if (extend_p)
+ {
+ long dw = (entry - count_end);
+ count_end = (end_scan_buffer_extension (count_end));
+ entry = (count_end + dw);
+ }
+ scan = ((SCHEME_OBJECT *) (count_end - delta));
+ }
-DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0)
-{
- SCHEME_OBJECT root;
- PRIMITIVE_HEADER (3);
+ if (count > 0)
+ compiled_code_present_p = true;
- root = (ARG_REF (1));
+ /* MANIFEST_CLOSURE_END assumes that one will be added to
+ result, so do that now. */
+ closure_end
+ = ((char *) ((MANIFEST_CLOSURE_END (scan, count)) + 1));
- if (STRING_P (ARG_REF (2)))
- PRIMITIVE_RETURN (dump_to_file (root, (STRING_ARG (2))));
- else
- {
- extern char * EXFUN (mktemp, (char *));
- extern int EXFUN (OS_channel_copy,
- (off_t source_length,
- Tchannel source_channel,
- Tchannel destination_channel));
+ /* The closures are copied sequentially, but extra hair is
+ required because the code-entry pointers are encoded as
+ machine instructions. */
+ while (count > 0)
+ {
+ char * entry_end = (CLOSURE_ENTRY_END (entry));
+ int extend_p = (entry_end >= ((char *) scan_buffer_top));
+ SCHEME_OBJECT esaddr;
+ SCHEME_OBJECT * old_start;
+ long delta1 = (entry - entry_end);
+ long delta2 = (closure_end - entry_end);
+
+ /* If the closure overflows the scan buffer, extend
+ the buffer to the end of the closure. */
+ if (extend_p)
+ extend_scan_buffer (entry_end, free);
+
+ /* Extract the code-entry pointer and convert it to a
+ C pointer. */
+ BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS (esaddr, entry);
+ Get_Compiled_Block (old_start, (SCHEME_ADDR_TO_ADDR (esaddr)));
+
+ /* Copy the code entry. Use machine-specific macro to
+ update the pointer. */
+ if (BROKEN_HEART_P (*old_start))
+ BCH_STORE_CLOSURE_ENTRY_ADDRESS
+ ((RELOCATE_COMPILED_RAW_ADDRESS
+ (esaddr, (OBJECT_ADDRESS (*old_start)), old_start)),
+ entry);
+ else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ PUSH_FIXUP_DATA (old_start);
+ BCH_ALIGN_FLOAT (new_address, free);
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ BCH_STORE_CLOSURE_ENTRY_ADDRESS
+ ((RELOCATE_COMPILED_RAW_ADDRESS
+ (esaddr, new_address, old_start)),
+ entry);
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+
+ if (extend_p)
+ {
+ entry_end = (end_scan_buffer_extension (entry_end));
+ entry = (entry_end + delta1);
+ closure_end = (entry_end + delta2);
+ }
+
+ entry = (NEXT_MANIFEST_CLOSURE_ENTRY (entry));
+ count -= 1;
+ }
+ scan = ((SCHEME_OBJECT *) closure_end);
+ MAYBE_DUMP_SCAN (scan);
+ BCH_END_CLOSURE_RELOCATION (scan);
+ }
+ break;
- int copy_result;
- SCHEME_OBJECT fasdump_result;
- Tchannel channel, temp_channel;
- char temp_name [(sizeof (FASDUMP_FILENAME)) + 1];
+ case TC_ENVIRONMENT:
+ /* Make fasdump fail */
+ return (ERR_FASDUMP_ENVIRONMENT);
- {
- char * scan1 = &FASDUMP_FILENAME[0];
- char * scan2 = temp_name;
- while (1)
- if (((*scan2++) = (*scan1++)) == '\0')
+ case TC_FUTURE:
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else if (Future_Spliceable (object))
+ (*scan) = (Future_Value (object));
+ else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ PUSH_FIXUP_DATA (old_start);
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+ }
break;
- }
- channel = (arg_channel (2));
- {
- char * temp_file = (mktemp (temp_name));
- if ((temp_file == ((char *) NULL)) || (*temp_file == '\0'))
- signal_error_from_primitive (ERR_EXTERNAL_RETURN);
+ default:
+ GC_BAD_TYPE ("dump_loop", object);
+ scan += 1;
+ break;
+ }
}
- fasdump_result = (dump_to_file (root, (temp_name)));
- if (fasdump_result != SHARP_T)
- PRIMITIVE_RETURN (fasdump_result);
-
- temp_channel = (OS_open_input_file (temp_name));
- copy_result = (OS_channel_copy ((OS_file_length (temp_channel)),
- temp_channel,
- channel));
- OS_channel_close (temp_channel);
- OS_file_remove (temp_name);
- if (copy_result < 0)
- signal_error_from_primitive (ERR_IO_ERROR);
- PRIMITIVE_RETURN (SHARP_T);
- }
-}
-\f
-extern SCHEME_OBJECT
- compiler_utilities,
- * EXFUN (cons_c_code_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
-
-/* (DUMP-BAND PROCEDURE FILE-NAME)
- Saves all of the heap and pure space on FILE-NAME. When the
- file is loaded back using BAND_LOAD, PROCEDURE is called with an
- argument of #F.
-*/
-
-DEFINE_PRIMITIVE ("DUMP-BAND", Prim_band_dump, 2, 2, 0)
-{
- SCHEME_OBJECT
- Combination, * saved_free,
- * prim_table_start, * prim_table_end,
- * c_table_start, * c_table_end;
- long
- prim_table_length,
- c_table_length;
- Boolean result = false;
- PRIMITIVE_HEADER (2);
-
- Band_Dump_Permitted ();
- CHECK_ARG (1, INTERPRETER_APPLICABLE_P);
- CHECK_ARG (2, STRING_P);
- if (Unused_Heap_Bottom < Heap_Bottom)
- /* Cause the image to be in the low heap, to increase
- the probability that no relocation is needed on reload. */
- Primitive_GC (0);
- Primitive_GC_If_Needed (5);
- saved_free = Free;
- Combination = (MAKE_POINTER_OBJECT (TC_COMBINATION_1, Free));
- Free[COMB_1_FN] = (ARG_REF (1));
- Free[COMB_1_ARG_1] = SHARP_F;
- Free += 2;
- (* Free++) = Combination;
- (* Free++) = compiler_utilities;
- (* Free) = (MAKE_POINTER_OBJECT (TC_LIST, (Free - 2)));
- Free ++; /* Some compilers are TOO clever about this and increment Free
- before calculating Free-2! */
- prim_table_start = Free;
- prim_table_end = (cons_whole_primitive_table (prim_table_start,
- Heap_Top,
- &prim_table_length));
- if (prim_table_end >= Heap_Top)
- goto done;
-
- c_table_start = prim_table_end;
- c_table_end = (cons_c_code_table (c_table_start, Heap_Top, &c_table_length));
- if (c_table_end >= Heap_Top)
- goto done;
-
- {
- SCHEME_OBJECT * faligned_heap, * faligned_constant;
- CONST char * filename = ((CONST char *) (STRING_LOC ((ARG_REF (2)), 0)));
-
- OS_file_remove_link (filename);
- dump_channel = (OS_open_dump_file (filename));
- if (dump_channel == NO_CHANNEL)
- error_bad_range_arg (2);
-
- for (faligned_heap = Heap_Bottom;
- (! (FLOATING_ALIGNED_P (faligned_heap)));
- faligned_heap += 1)
- ;
-
- for (faligned_constant = Constant_Space;
- (! (FLOATING_ALIGNED_P (faligned_constant)));
- faligned_constant += 1)
- ;
-
- result = (Write_File ((Free - 1),
- ((long) (Free - faligned_heap)),
- faligned_heap,
- ((long) (Free_Constant - faligned_constant)),
- faligned_constant,
- prim_table_start, prim_table_length,
- ((long) (prim_table_end - prim_table_start)),
- c_table_start, c_table_length,
- ((long) (c_table_end - c_table_start)),
- (compiler_utilities != SHARP_F), true));
- OS_channel_close_noerror (dump_channel);
- if (! result)
- OS_file_remove (filename);
- }
-
-done:
- Band_Dump_Exit_Hook ();
- Free = saved_free;
- PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (result));
+ end_dump_loop:
+ (*free_ptr) = free;
+ (*new_address_ptr) = new_address;
+ return (PRIM_DONE);
}
/* -*- C -*-
-$Id: bchdrn.c,v 1.9 2000/01/18 03:04:40 cph Exp $
+$Id: bchdrn.c,v 1.10 2000/12/05 21:23:42 cph Exp $
Copyright (c) 1991-2000 Massachusetts Institute of Technology
extern char * EXFUN (error_name, (int));
extern int EXFUN (retrying_file_operation,
- (/* no prototype because (CONST char *) != (char *) */
- int EXFUN((*), ()),
+ (ssize_t EXFUN ((*), (int, char *, int)),
int, char *, long, long, char *, char *, long *,
- int EXFUN((*), (char *, char *))));
+ int EXFUN ((*), (char *, char *))));
\f
-#ifdef HAVE_SYSV_SHARED_MEMORY
+#ifdef USE_SYSV_SHARED_MEMORY
static struct
{
static jmp_buf abort_point;
static pid_t boss_pid;
\f
-static void EXFUN (shutdown, (int sig));
+static void EXFUN (kill_program, (int sig));
static void
DEFUN (posix_signal, (signum, handler),
fprintf (stderr, "%s (%d, posix_signal): sigaction failed. errno = %s.\n",
arguments.program_name, myself->index, (error_name (errno)));
fflush (stderr);
- shutdown (0);
+ kill_program (0);
/*NOTREACHED*/
}
return;
}
static void
-DEFUN (shutdown, (sig), int sig)
+DEFUN (kill_program, (sig), int sig)
{
myself->state = drone_dead;
if (gc_fid != -1)
static void
DEFUN (process_requests, (drone), struct drone_info * drone)
{
-#if !(defined(_HPUX) && (_HPUX_VERSION >= 80))
- extern int EXFUN (select, (int, int *, int *, int *, struct timeval *));
-#endif
sigset_t non_blocking_signal_mask, blocking_signal_mask;
int result, count, buffer_index, flags;
long current_position = -1;
fflush (stderr);
if (drone->DRONE_PPID == boss_pid)
(void) (kill (boss_pid, SIGCONT));
- shutdown (0);
+ kill_program (0);
/*NOTREACHED*/
}
#ifdef DEBUG_1
"\n%s (%d, process_requests): Unknown/bad operation %d.\n",
arguments.program_name, drone->index, drone->state);
fflush (stderr);
- shutdown (0);
+ kill_program (0);
/*NOTREACHED*/
case drone_idle:
UX_sigprocmask (SIG_SETMASK, (&non_blocking_signal_mask), 0);
result = (retrying_file_operation
- (((operation == drone_reading)
- ? ((int (*) ()) read)
- : ((int (*) ()) write)),
+ (((operation == drone_reading) ? read : write),
gc_fid, buffer_address,
buffer->position, buffer->size, operation_name, NULL,
¤t_position, always_one));
{
count = 0;
if ((kill (boss_pid, 0)) == -1)
- shutdown (-1);
+ kill_program (-1);
}
read_mask = (* wait_mask);
if ((read_mask & my_mask) == my_mask)
#endif
posix_signal (SIGINT, SIG_IGN);
posix_signal (SIGQUIT, SIG_IGN);
- posix_signal (SIGHUP, shutdown);
- posix_signal (SIGTERM, shutdown);
+ posix_signal (SIGHUP, kill_program);
+ posix_signal (SIGTERM, kill_program);
gc_buffers = ((struct buffer_info *)
(shared_memory + (arguments.nbuf * arguments.bufsiz)));
#define MAIN main
-#endif /* HAVE_SYSV_SHARED_MEMORY */
+#endif /* USE_SYSV_SHARED_MEMORY */
\f
#ifndef MAIN
/* -*-C-*-
-$Id: bchdrn.h,v 1.9 1999/01/02 06:11:34 cph Exp $
+$Id: bchdrn.h,v 1.10 2000/12/05 21:23:42 cph Exp $
-Copyright (c) 1991-1999 Massachusetts Institute of Technology
+Copyright (c) 1991-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#ifndef _BCHDRN_H_INCLUDED
#define _BCHDRN_H_INCLUDED
-#include "ansidecl.h"
-#include "oscond.h"
+#include "config.h"
#include <errno.h>
#include <signal.h>
-#if defined(_POSIX) || defined(_SUNOS4)
+#ifdef HAVE_UNISTD_H
# include <unistd.h>
#else
-#ifndef DOS386
-#ifndef _OS2
-#ifndef WINNT
- extern int EXFUN (read, (int, PTR, unsigned int));
- extern int EXFUN (write, (int, PTR, unsigned int));
-#endif
-#endif
-#endif
+# ifdef __unix__
+ extern ssize_t EXFUN (read, (int, PTR, size_t));
+ extern ssize_t EXFUN (write, (int, PTR, size_t));
+# endif
#endif
-#if defined(HAVE_POSIX_SIGNALS) && defined(HAVE_BSD_SIGNALS)
+#ifdef HAVE_POSIX_SIGNALS
# define RE_INSTALL_HANDLER(signum,handler) do { } while (0)
#else
# define RE_INSTALL_HANDLER(signum,handler) signal (signum, handler)
#endif
-/* #define AVOID_SYSV_SHARED_MEMORY */
+/* Doesn't work on GNU/Linux or on FreeBSD. Disable until we can
+ figure out what is going on. */
+#define AVOID_SYSV_SHARED_MEMORY
-#ifndef AVOID_SYSV_SHARED_MEMORY
-# if defined(_SYSV4) || defined(_SUNOS4) || defined(_ULTRIX)
-# define HAVE_SYSV_SHARED_MEMORY
-# endif
-# if defined(_HPUX) || defined(__osf__) || defined(_AIX)
-# define HAVE_SYSV_SHARED_MEMORY
-# endif
+#if !defined(AVOID_SYSV_SHARED_MEMORY) && defined(HAVE_SHMAT)
+# define USE_SYSV_SHARED_MEMORY
#endif
\f
-#if defined(_HPUX)
+#if defined(__HPUX__)
# define HAVE_PREALLOC
/* Page tables can have no gaps in HP-UX < 8.0, leave a gap for malloc. */
-# ifdef hp9000s300
+# if defined(hp9000s300) || defined(__hp9000s300)
# ifdef hpux8
# define ATTACH_POINT 0x60000000
# else /* not hpux8 */
# endif /* hpux8 */
# endif /* hp9000s300 */
-#endif /* _HPUX */
+#endif /* __HPUX__ */
-#ifdef HAVE_SYSV_SHARED_MEMORY
+#ifdef USE_SYSV_SHARED_MEMORY
#define DRONE_VERSION_NUMBER ((1 << 8) | 2)
#define DRONE_PID drone_extra.my_pid
#define DRONE_PPID drone_extra.my_ppid
-#endif /* HAVE_SYSV_SHARED_MEMORY */
+#endif /* USE_SYSV_SHARED_MEMORY */
\f
/* Shared definitions for all versions */
/* -*-C-*-
-$Id: bchgcc.h,v 9.62 2000/11/29 21:25:54 cph Exp $
+$Id: bchgcc.h,v 9.63 2000/12/05 21:23:42 cph Exp $
Copyright (c) 1987-2000 Massachusetts Institute of Technology
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
-#ifndef _BCHGCC_H_INCLUDED
+#ifndef SCM_BCHGCC_H
+#define SCM_BCHGCC_H
-#define _BCHGCC_H_INCLUDED
-
-#include "oscond.h"
+#include "config.h"
#include "gccode.h"
-#ifdef _BSD
+#ifdef HAVE_SYS_FILE_H
# include <sys/file.h>
-#else
-# ifndef F_GETFL
-# include <fcntl.h>
-# endif
#endif
-
-#ifdef DOS386
-# define IO_PAGE_SIZE 4096
+#ifdef HAVE_FCNTL_H
+# include <fcntl.h>
#endif
-#ifdef WINNT
+
+#ifdef __WIN32__
# define IO_PAGE_SIZE 4096
#endif
-#ifdef _OS2
+#ifdef __OS2__
# define IO_PAGE_SIZE 4096
#endif
#ifndef IO_PAGE_SIZE
-# include <sys/param.h>
+# include <sys/param.h>
#endif
\f
#ifndef BCH_START_CLOSURE_RELOCATION
# define BCH_STORE_OPERATOR_LINKAGE_ADDRESS STORE_OPERATOR_LINKAGE_ADDRESS
#endif
-#ifdef _POSIX
-# include <sys/types.h>
-#else /* not _POSIX */
-#ifndef __osf__
-# define ssize_t int
-#endif /* not __osf__ */
-#endif /* not _POSIX */
-
extern char * EXFUN (error_name, (int));
+typedef ssize_t EXFUN (file_operation_t, (int, char *, int));
+
extern int EXFUN (retrying_file_operation,
- (/* no prototype because (CONST char *) != (char *) */
- ssize_t EXFUN ((*), ()),
+ (file_operation_t *,
int, char *, long, long, char *, char *, long *,
int EXFUN ((*), (char *, char *))));
extern int EXFUN (io_error_retry_p, (char *, char *));
extern int EXFUN (io_error_always_abort, (char *, char *));
+extern char * EXFUN (make_gc_file_name, (CONST char *));
+extern int EXFUN (allocate_gc_file, (char *));
+extern void EXFUN (protect_gc_file_name, (CONST char *));
+
struct saved_scan_state
{
SCHEME_OBJECT * virtual_scan_pointer;
(set_fixed_scan_area, (SCHEME_OBJECT * bottom, SCHEME_OBJECT * top));
\f
#ifndef O_BINARY
-# define O_BINARY 0
+# define O_BINARY 0
#endif
#define GC_FILE_FLAGS (O_RDWR | O_CREAT | O_BINARY) /* O_SYNCIO removed */
* weak_pair_stack_limit,
* virtual_scan_pointer;
\f
+typedef enum { NORMAL_GC, PURE_COPY, CONSTANT_COPY } gc_mode_t;
+
+extern SCHEME_OBJECT * EXFUN
+ (gc_loop, (SCHEME_OBJECT *, SCHEME_OBJECT **, SCHEME_OBJECT **,
+ SCHEME_OBJECT *, gc_mode_t, int));
+
extern SCHEME_OBJECT
- * EXFUN (GCLoop, (SCHEME_OBJECT *, SCHEME_OBJECT **, SCHEME_OBJECT **)),
- * EXFUN (dump_and_reload_scan_buffer, (long, Boolean *)),
- * EXFUN (dump_and_reset_free_buffer, (long, Boolean *)),
+ * EXFUN (dump_and_reload_scan_buffer, (SCHEME_OBJECT *, Boolean *)),
+ * EXFUN (dump_and_reset_free_buffer, (SCHEME_OBJECT *, Boolean *)),
* EXFUN (dump_free_directly, (SCHEME_OBJECT *, long, Boolean *)),
* EXFUN (initialize_free_buffer, (void)),
* EXFUN (initialize_scan_buffer, (SCHEME_OBJECT *)),
EXFUN (gc_death, (long, char *, SCHEME_OBJECT *, SCHEME_OBJECT *)),
EXFUN (restore_gc_file, (void)),
EXFUN (initialize_weak_pair_transport, (SCHEME_OBJECT *)),
- EXFUN (fix_weak_chain_1, (void)),
+ EXFUN (fix_weak_chain_1, (SCHEME_OBJECT *)),
EXFUN (fix_weak_chain_2, (void)),
EXFUN (GC_end_root_relocation, (SCHEME_OBJECT *, SCHEME_OBJECT *));
extern int
EXFUN (swap_gc_file, (int));
+
+extern Boolean EXFUN (update_allocator_parameters, (SCHEME_OBJECT *));
+extern void EXFUN (reset_allocator_parameters, (void));
\f
/* Some utility macros */
(loc) = (read_newspace_address (_addr)); \
} while (0)
-#define copy_weak_pair() \
-{ \
- SCHEME_OBJECT weak_car; \
- long car_type; \
- \
- weak_car = (*Old++); \
- car_type = (OBJECT_TYPE (weak_car)); \
- if ((car_type == TC_NULL) \
- || ((OBJECT_ADDRESS (weak_car)) < low_heap)) \
- { \
- *To++ = weak_car; \
- *To++ = (*Old); \
- } \
- else if (weak_pair_stack_ptr > weak_pair_stack_limit) \
- { \
- *--weak_pair_stack_ptr = ((SCHEME_OBJECT) To_Address); \
- *--weak_pair_stack_ptr = weak_car; \
- *To++ = SHARP_F; \
- *To++ = (*Old); \
- } \
- else \
- { \
- *To++ = (OBJECT_NEW_TYPE (TC_NULL, weak_car)); \
- *To++ = *Old; \
- *Old = (OBJECT_NEW_TYPE (car_type, Weak_Chain)); \
- Weak_Chain = Temp; \
- } \
-}
-\f
-#define copy_cell() \
-{ \
- *To++ = *Old; \
-}
-
-#define copy_pair() \
-{ \
- *To++ = *Old++; \
- *To++ = *Old; \
-}
-
-#define copy_triple() \
-{ \
- *To++ = *Old++; \
- *To++ = *Old++; \
- *To++ = *Old; \
-}
-
-#define copy_quadruple() \
-{ \
- *To++ = *Old++; \
- *To++ = *Old++; \
- *To++ = *Old++; \
- *To++ = *Old; \
-}
-
-/* Transporting vectors is done in 3 parts:
- - Finish filling the current free buffer, dump it, and get a new one.
- - Dump the middle of the vector directly by bufferfulls.
- - Copy the end of the vector to the new buffer.
- The last piece of code is the only one executed when the vector does
- not overflow the current buffer.
-*/
-
-#define copy_vector(success) \
-{ \
- SCHEME_OBJECT * Saved_Scan = Scan; \
- unsigned long real_length = (1 + (OBJECT_DATUM (*Old))); \
- \
- To_Address += real_length; \
- Scan = (To + real_length); \
- if (Scan >= free_buffer_top) \
- { \
- unsigned long overflow; \
- \
- overflow = (Scan - free_buffer_top); \
- while (To != free_buffer_top) \
- *To++ = *Old++; \
- To = (dump_and_reset_free_buffer (0, success)); \
- real_length = (overflow >> gc_buffer_shift); \
- if (real_length > 0) \
- To = dump_free_directly (Old, real_length, success); \
- Old += (real_length << gc_buffer_shift); \
- Scan = To + (overflow & gc_buffer_mask); \
- } \
- while (To != Scan) \
- *To++ = *Old++; \
- Scan = Saved_Scan; \
-}
-\f
-/* Utility macros. */
-
-#define relocate_normal_setup() \
-{ \
- Old = (OBJECT_ADDRESS (Temp)); \
- if (Old < low_heap) \
- continue; \
- if ((OBJECT_TYPE (*Old)) == TC_BROKEN_HEART) \
- { \
- *Scan = (MAKE_OBJECT_FROM_OBJECTS (Temp, *Old)); \
- continue; \
- } \
- New_Address = (MAKE_BROKEN_HEART (To_Address)); \
-}
-
-#define relocate_normal_transport(copy_code, length) \
-{ \
- copy_code; \
- To_Address += (length); \
- if (To >= free_buffer_top) \
- To = (dump_and_reset_free_buffer ((To - free_buffer_top), NULL)); \
-}
-
-#define relocate_normal_end() \
-{ \
- (* (OBJECT_ADDRESS (Temp))) = New_Address; \
- (* Scan) = (MAKE_OBJECT_FROM_OBJECTS (Temp, New_Address)); \
- continue; \
-}
-
-#define relocate_normal_pointer(copy_code, length) \
-{ \
- relocate_normal_setup (); \
- relocate_normal_transport (copy_code, length); \
- relocate_normal_end (); \
-}
-
#ifdef FLOATING_ALIGNMENT
-#define FLOAT_ALIGN_FREE(free,free_ptr) \
-do { \
- while ((((long) ((free) + 1)) & FLOATING_ALIGNMENT) != 0) \
- { \
- free += 1; \
- *free_ptr++ = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0)); \
- } \
-} while (0)
-
-#define relocate_flonum_setup() \
-{ \
- relocate_normal_setup (); \
- FLOAT_ALIGN_FREE (To_Address, To); \
- New_Address = (MAKE_BROKEN_HEART (To_Address)); \
-}
-
-#else /* FLOATING_ALIGNMENT */
-
-#define FLOAT_ALIGN_FREE(free,free_ptr) \
-do { \
-} while (0)
-
-#define relocate_flonum_setup() relocate_normal_setup()
-
-#endif /* FLOATING_ALIGNMENT */
-\f
-/* Typeless objects (implicit types). */
-
-#define relocate_typeless_setup() \
+#define BCH_ALIGN_FLOAT(address, pointer) \
{ \
- Old = (SCHEME_ADDR_TO_ADDR (Temp)); \
- if (Old < low_heap) \
- continue; \
- if (BROKEN_HEART_P (* Old)) \
- { \
- (* Scan) = (ADDR_TO_SCHEME_ADDR (OBJECT_ADDRESS (* Old))); \
- continue; \
- } \
- New_Address = ((SCHEME_OBJECT) To_Address); \
+ while (!FLOATING_ALIGNED_P (address)) \
+ { \
+ (address) += 1; \
+ (* ((pointer)++)) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0)); \
+ } \
}
-#define relocate_typeless_end() \
+#define BCH_ALIGN_FLOAT_ADDRESS(address) \
{ \
- (* (SCHEME_ADDR_TO_ADDR (Temp))) \
- = (MAKE_BROKEN_HEART ((SCHEME_OBJECT *) (New_Address))); \
- (* Scan) = (ADDR_TO_SCHEME_ADDR (New_Address)); \
- continue; \
+ while (!FLOATING_ALIGNED_P (address)) \
+ (address) += 1; \
}
-#define relocate_typeless_pointer(copy_code, length) \
-{ \
- relocate_typeless_setup (); \
- relocate_normal_transport (copy_code, length); \
- relocate_typeless_end (); \
-}
-\f
-/* The following macro uses do-while to trap the use of continue.
- On certain machines, the operator/closure need to be updated
- since the only addressing mode is pc-relative and the object
- containing the reference may not be at the same address as it was
- last time.
- In addition, we may be in the middle of a scan-buffer extension,
- which we need to finish.
- */
-
-#define relocate_compiled_entry(in_gc_p) do \
-{ \
- Old = (OBJECT_ADDRESS (Temp)); \
- if (Old < low_heap) \
- continue; \
- Compiled_BH (in_gc_p, continue); \
- { \
- SCHEME_OBJECT * Saved_Old = Old; \
- \
- FLOAT_ALIGN_FREE (To_Address, To); \
- New_Address = (MAKE_BROKEN_HEART (To_Address)); \
- copy_vector (NULL); \
- * Saved_Old = New_Address; \
- Temp = (RELOCATE_COMPILED (Temp, \
- (OBJECT_ADDRESS (New_Address)), \
- Saved_Old)); \
- continue; \
- } \
-} while (0)
-
-#define relocate_raw_compiled_entry(in_gc_p) do \
-{ \
- Old = (SCHEME_ADDR_TO_ADDR (Temp)); \
- if (Old < low_heap) \
- continue; \
- RAW_COMPILED_BH (in_gc_p, continue); \
- { \
- SCHEME_OBJECT * Saved_Old = Old; \
- \
- FLOAT_ALIGN_FREE (To_Address, To); \
- New_Address = (MAKE_BROKEN_HEART (To_Address)); \
- copy_vector (NULL); \
- * Saved_Old = New_Address; \
- Temp = (RELOCATE_COMPILED_RAW_ADDRESS \
- (Temp, \
- (OBJECT_ADDRESS (New_Address)), \
- Saved_Old)); \
- continue; \
- } \
-} while (0)
-
-#define relocate_linked_operator(in_gc_p) do \
-{ \
- Scan = ((SCHEME_OBJECT *) (word_ptr)); \
- BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
- relocate_raw_compiled_entry (in_gc_p); \
- BCH_STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
-} while (0)
-
-#define relocate_manifest_closure(in_gc_p) do \
-{ \
- Scan = ((SCHEME_OBJECT *) (word_ptr)); \
- BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
- relocate_raw_compiled_entry (in_gc_p); \
- BCH_STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
-} while (0)
+#else
+#define BCH_ALIGN_FLOAT(address, pointer)
+#define BCH_ALIGN_FLOAT_ADDRESS(address)
+#endif
-#endif /* _BCHGCC_H_INCLUDED */
+#endif /* SCM_BCHGCC_H */
/* -*-C-*-
-$Id: bchgcl.c,v 9.50 1999/01/02 06:11:34 cph Exp $
+$Id: bchgcl.c,v 9.51 2000/12/05 21:23:42 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
-/* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag,
- purify, and fasdump, respectively, to provide garbage collection
- and related utilities to disk. */
+/* This is the main GC loop for bchscheme. */
#include "scheme.h"
#include "bchgcc.h"
\f
-SCHEME_OBJECT *
-DEFUN (GCLoop, (Scan, To_ptr, To_Address_ptr),
- fast SCHEME_OBJECT * Scan AND
- SCHEME_OBJECT ** To_ptr AND
- SCHEME_OBJECT ** To_Address_ptr)
-{
- fast SCHEME_OBJECT
- * To, * Old, Temp, * low_heap,
- * To_Address, New_Address;
+#define MAYBE_DUMP_FREE(free) \
+{ \
+ if (free >= free_buffer_top) \
+ DUMP_FREE (free); \
+}
- To = (* To_ptr);
- To_Address = (* To_Address_ptr);
- low_heap = Constant_Top;
+#define DUMP_FREE(free) \
+ free = (dump_and_reset_free_buffer (free, 0))
+
+#define MAYBE_DUMP_SCAN(scan) \
+{ \
+ if (scan >= scan_buffer_top) \
+ DUMP_SCAN (scan); \
+}
- for ( ; Scan != To; Scan++)
+#define DUMP_SCAN(scan) \
+ scan = (dump_and_reload_scan_buffer (scan, 0))
+
+#define TRANSPORT_VECTOR(new_address, free, old_start, n_words) \
+{ \
+ SCHEME_OBJECT * old_ptr = old_start; \
+ SCHEME_OBJECT * free_end = (free + n_words); \
+ if (free_end < free_buffer_top) \
+ while (free < free_end) \
+ (*free++) = (*old_ptr++); \
+ else \
+ { \
+ while (free < free_buffer_top) \
+ (*free++) = (*old_ptr++); \
+ free = (transport_vector_tail (free, free_end, old_ptr)); \
+ } \
+}
+
+static SCHEME_OBJECT *
+DEFUN (transport_vector_tail, (free, free_end, tail),
+ SCHEME_OBJECT * free AND
+ SCHEME_OBJECT * free_end AND
+ SCHEME_OBJECT * tail)
+{
+ unsigned long n_words = (free_end - free);
+ DUMP_FREE (free);
+ {
+ unsigned long n_blocks = (n_words >> gc_buffer_shift);
+ if (n_blocks > 0)
+ {
+ free = (dump_free_directly (tail, n_blocks, 0));
+ tail += (n_blocks << gc_buffer_shift);
+ }
+ }
{
- Temp = (* Scan);
- Switch_by_GC_Type (Temp)
+ SCHEME_OBJECT * free_end = (free + (n_words & gc_buffer_mask));
+ while (free < free_end)
+ (*free++) = (*tail++);
+ }
+ return (free);
+}
+\f
+SCHEME_OBJECT *
+DEFUN (gc_loop,
+ (scan, free_ptr, new_address_ptr, low_heap, gc_mode,
+ require_normal_end),
+ SCHEME_OBJECT * scan AND
+ SCHEME_OBJECT ** free_ptr AND
+ SCHEME_OBJECT ** new_address_ptr AND
+ SCHEME_OBJECT * low_heap AND
+ gc_mode_t gc_mode AND
+ int require_normal_end)
+{
+ SCHEME_OBJECT * free = (*free_ptr);
+ SCHEME_OBJECT * new_address = (*new_address_ptr);
+ while (scan != free)
{
- case TC_BROKEN_HEART:
- if (Temp != (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Scan)))
+ SCHEME_OBJECT object;
+ if (scan >= scan_buffer_top)
+ {
+ if (scan == scan_buffer_top)
+ DUMP_SCAN (scan);
+ else
+ {
+ sprintf
+ (gc_death_message_buffer,
+ "gc_loop: scan (0x%lx) > scan_buffer_top (0x%lx)",
+ ((unsigned long) scan),
+ ((unsigned long) scan_buffer_top));
+ gc_death (TERM_EXIT, gc_death_message_buffer, scan, free);
+ /*NOTREACHED*/
+ }
+ }
+ object = (*scan);
+ switch (OBJECT_TYPE (object))
{
+ case TC_BROKEN_HEART:
+ if (gc_mode != NORMAL_GC)
+ goto end_gc_loop;
+ if (object == (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, scan)))
+ /* Does this ever happen? */
+ goto end_gc_loop;
sprintf (gc_death_message_buffer,
- "gcloop: broken heart (0x%lx) in scan",
- Temp);
- gc_death (TERM_BROKEN_HEART, gc_death_message_buffer, Scan, To);
+ "gc_loop: broken heart (0x%lx) in scan",
+ object);
+ gc_death (TERM_BROKEN_HEART, gc_death_message_buffer, scan, free);
/*NOTREACHED*/
- }
- if (Scan != scan_buffer_top)
- goto end_gcloop;
- /* The -1 is here because of the Scan++ in the for header. */
- Scan = ((dump_and_reload_scan_buffer (0, NULL)) - 1);
- continue;
-
- case TC_MANIFEST_NM_VECTOR:
- case TC_MANIFEST_SPECIAL_NM_VECTOR:
- /* Check whether this bumps over current buffer,
- and if so we need a new bufferfull. */
- Scan += (OBJECT_DATUM (Temp));
-area_skipped:
- if (Scan < scan_buffer_top)
break;
- else
- {
- unsigned long overflow;
- /* The + & -1 are here because of the Scan++ in the for header. */
- overflow = ((Scan - scan_buffer_top) + 1);
- Scan = ((dump_and_reload_scan_buffer
- ((overflow >> gc_buffer_shift), NULL)
- + (overflow & gc_buffer_mask)) - 1);
+ case TC_CHARACTER:
+ case TC_CONSTANT:
+ case TC_FIXNUM:
+ case TC_NULL:
+ case TC_PCOMB0:
+ case TC_PRIMITIVE:
+ case TC_RETURN_CODE:
+ case TC_STACK_ENVIRONMENT:
+ case TC_THE_ENVIRONMENT:
+ scan += 1;
break;
- }
-\f
- case_compiled_entry_point:
- relocate_compiled_entry (true);
- (* Scan) = Temp;
- break;
- case TC_LINKAGE_SECTION:
- {
- switch (READ_LINKAGE_KIND (Temp))
- {
- case REFERENCE_LINKAGE_KIND:
- case ASSIGNMENT_LINKAGE_KIND:
+ case TC_CELL:
+ if (gc_mode == CONSTANT_COPY)
+ {
+ scan += 1;
+ break;
+ }
{
- /* count typeless pointers to quads follow. */
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
+ {
+ (*free++) = (old_start[0]);
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 1;
+ }
+ }
+ break;
- fast long count;
- long max_count, max_here;
+ case TC_ACCESS:
+ case TC_ASSIGNMENT:
+ case TC_COMBINATION_1:
+ case TC_COMMENT:
+ case TC_COMPLEX:
+ case TC_DEFINITION:
+ case TC_DELAY:
+ case TC_DELAYED:
+ case TC_DISJUNCTION:
+ case TC_ENTITY:
+ case TC_EXTENDED_PROCEDURE:
+ case TC_IN_PACKAGE:
+ case TC_LAMBDA:
+ case TC_LEXPR:
+ case TC_LIST:
+ case TC_PCOMB1:
+ case TC_PROCEDURE:
+ case TC_RATNUM:
+ case TC_SCODE_QUOTE:
+ case TC_SEQUENCE_2:
+ transport_pair:
+ if (gc_mode == CONSTANT_COPY)
+ {
+ scan += 1;
+ break;
+ }
+ goto really_transport_pair;
- Scan++;
- max_here = (scan_buffer_top - Scan);
- max_count = (READ_CACHE_LINKAGE_COUNT (Temp));
- while (max_count != 0)
+ case TC_INTERNED_SYMBOL:
+ case TC_UNINTERNED_SYMBOL:
+ if (gc_mode == PURE_COPY)
{
- count = ((max_count > max_here) ? max_here : max_count);
- max_count -= count;
- for ( ; --count >= 0; Scan += 1)
+ SCHEME_OBJECT name = (MEMORY_REF (object, SYMBOL_NAME));
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (name));
+ if ((old_start < low_heap)
+ || (BROKEN_HEART_P (*old_start)))
+ scan += 1;
+ else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ (*scan++) = (OBJECT_NEW_ADDRESS (name, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+ break;
+ }
+ really_transport_pair:
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
{
- Temp = (* Scan);
- relocate_typeless_pointer (copy_quadruple (), 4);
+ (*free++) = (old_start[0]);
+ (*free++) = (old_start[1]);
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 2;
}
- if (max_count != 0)
+ }
+ break;
+
+ case TC_COMBINATION_2:
+ case TC_CONDITIONAL:
+ case TC_EXTENDED_LAMBDA:
+ case TC_HUNK3_A:
+ case TC_HUNK3_B:
+ case TC_PCOMB2:
+ case TC_SEQUENCE_3:
+ case TC_VARIABLE:
+ if (gc_mode == CONSTANT_COPY)
+ {
+ scan += 1;
+ break;
+ }
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
{
- /* We stopped because we needed to relocate too many. */
- Scan = (dump_and_reload_scan_buffer (0, NULL));
- max_here = gc_buffer_size;
+ (*free++) = (old_start[0]);
+ (*free++) = (old_start[1]);
+ (*free++) = (old_start[2]);
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 3;
}
- }
- /* The + & -1 are here because of the Scan++ in the for header. */
- Scan -= 1;
- break;
}
-\f
- case OPERATOR_LINKAGE_KIND:
- case GLOBAL_OPERATOR_LINKAGE_KIND:
+ break;
+
+ case TC_QUAD:
+ if (gc_mode == CONSTANT_COPY)
+ {
+ scan += 1;
+ break;
+ }
{
- /* Operator linkage */
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
+ {
+ (*free++) = (old_start[0]);
+ (*free++) = (old_start[1]);
+ (*free++) = (old_start[2]);
+ (*free++) = (old_start[3]);
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 4;
+ }
+ }
+ break;
- fast long count;
- fast char * word_ptr, * next_ptr;
- long overflow;
+ case TC_BIG_FIXNUM:
+ case TC_CHARACTER_STRING:
+ case TC_COMBINATION:
+ case TC_CONTROL_POINT:
+ case TC_NON_MARKED_VECTOR:
+ case TC_PCOMB3:
+ case TC_RECORD:
+ case TC_VECTOR:
+ case TC_VECTOR_16B:
+ case TC_VECTOR_1B:
+ if (gc_mode == CONSTANT_COPY)
+ {
+ scan += 1;
+ break;
+ }
+ goto transport_vector;
- word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
- if (! (word_ptr > ((char *) scan_buffer_top)))
- BCH_START_OPERATOR_RELOCATION (Scan);
+ case TC_ENVIRONMENT:
+ if (gc_mode == PURE_COPY)
+ {
+ scan += 1;
+ break;
+ }
+ transport_vector:
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+ }
+ break;
+
+ case TC_BIG_FLONUM:
+ if (gc_mode == CONSTANT_COPY)
{
- overflow = (word_ptr - ((char *) Scan));
- extend_scan_buffer (word_ptr, To);
- BCH_START_OPERATOR_RELOCATION (Scan);
- word_ptr = (end_scan_buffer_extension (word_ptr));
- Scan = ((SCHEME_OBJECT *) (word_ptr - overflow));
+ scan += 1;
+ break;
}
-
- count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
- overflow = ((END_OPERATOR_LINKAGE_AREA (Scan, count)) -
- scan_buffer_top);
-
- for (next_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr));
- (--count >= 0);
- word_ptr = next_ptr,
- next_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr)))
+ goto transport_aligned_vector;
+
+ case TC_COMPILED_CODE_BLOCK:
+ if (gc_mode == PURE_COPY)
{
- if (! (next_ptr > ((char *) scan_buffer_top)))
- relocate_linked_operator (true);
- else
+ scan += 1;
+ break;
+ }
+ transport_aligned_vector:
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
{
- extend_scan_buffer (next_ptr, To);
- relocate_linked_operator (true);
- next_ptr = (end_scan_buffer_extension (next_ptr));
- overflow -= gc_buffer_size;
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ BCH_ALIGN_FLOAT (new_address, free);
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
}
+ }
+ break;
+
+ case TC_WEAK_CONS:
+ if (gc_mode == PURE_COPY)
+ {
+ scan += 1;
+ break;
}
- Scan = (scan_buffer_top + overflow);
- BCH_END_OPERATOR_RELOCATION (Scan);
- break;
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else
+ {
+ SCHEME_OBJECT weak_car = (old_start[0]);
+ if (((OBJECT_TYPE (weak_car)) == TC_NULL)
+ || ((OBJECT_ADDRESS (weak_car)) < low_heap))
+ {
+ (*free++) = weak_car;
+ (*free++) = (old_start[1]);
+ }
+ else if (weak_pair_stack_ptr > weak_pair_stack_limit)
+ {
+ (*--weak_pair_stack_ptr) = ((SCHEME_OBJECT) new_address);
+ (*--weak_pair_stack_ptr) = weak_car;
+ (*free++) = SHARP_F;
+ (*free++) = (old_start[1]);
+ }
+ else
+ {
+ (*free++) = (OBJECT_NEW_TYPE (TC_NULL, weak_car));
+ (*free++) = (old_start[1]);
+ (old_start[1])
+ = (MAKE_OBJECT_FROM_OBJECTS (weak_car, Weak_Chain));
+ Weak_Chain = object;
+ }
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 2;
+ }
}
+ break;
- case CLOSURE_PATTERN_LINKAGE_KIND:
- Scan += (READ_CACHE_LINKAGE_COUNT (Temp));
- goto area_skipped;
+ case TC_MANIFEST_NM_VECTOR:
+ case TC_MANIFEST_SPECIAL_NM_VECTOR:
+ scan += (1 + (OBJECT_DATUM (object)));
+ MAYBE_DUMP_SCAN (scan);
+ break;
- default:
- gc_death (TERM_EXIT,
- "GC: Unknown compiler linkage kind.",
- Scan, Free);
- /*NOTREACHED*/
- }
- break;
- }
-\f
- case TC_MANIFEST_CLOSURE:
- {
- fast long count;
- fast char * word_ptr;
- char * end_ptr;
+ case TC_REFERENCE_TRAP:
+ if ((OBJECT_DATUM (object)) > TRAP_MAX_IMMEDIATE)
+ goto transport_pair;
+ /* Otherwise it's a non-pointer. */
+ scan += 1;
+ break;
- Scan += 1;
+ case TC_COMPILED_ENTRY:
+ if (gc_mode == PURE_COPY)
+ {
+ scan += 1;
+ break;
+ }
+ {
+ SCHEME_OBJECT * old_start;
+ Get_Compiled_Block (old_start, (OBJECT_ADDRESS (object)));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++)
+ = (RELOCATE_COMPILED (object,
+ (OBJECT_ADDRESS (*old_start)),
+ old_start));
+ else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ BCH_ALIGN_FLOAT (new_address, free);
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ (*scan++)
+ = (RELOCATE_COMPILED (object, new_address, old_start));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+ }
+ break;
- /* Is there enough space to read the count? */
+ case TC_LINKAGE_SECTION:
+ if (gc_mode == PURE_COPY)
+ {
+ gc_death (TERM_COMPILER_DEATH,
+ "gc_loop: linkage section in pure area",
+ scan, free);
+ /*NOTREACHED*/
+ }
+ switch (READ_LINKAGE_KIND (object))
+ {
+ case REFERENCE_LINKAGE_KIND:
+ case ASSIGNMENT_LINKAGE_KIND:
+ {
+ /* `count' typeless pointers to quads follow. */
+ unsigned long count = (READ_CACHE_LINKAGE_COUNT (object));
+ scan += 1;
+ while (count > 0)
+ {
+ SCHEME_OBJECT * old_start = (SCHEME_ADDR_TO_ADDR (*scan));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++)
+ = (ADDR_TO_SCHEME_ADDR (OBJECT_ADDRESS (*old_start)));
+ else
+ {
+ (*free++) = (old_start[0]);
+ (*free++) = (old_start[1]);
+ (*free++) = (old_start[2]);
+ (*free++) = (old_start[3]);
+ MAYBE_DUMP_FREE (free);
+ (*scan++) = (ADDR_TO_SCHEME_ADDR (new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += 4;
+ }
+ MAYBE_DUMP_SCAN (scan);
+ count -= 1;
+ }
+ }
+ break;
- end_ptr = (((char *) Scan) + (2 * (sizeof (format_word))));
- if (end_ptr > ((char *) scan_buffer_top))
- {
- long dw;
-
- extend_scan_buffer (end_ptr, To);
- BCH_START_CLOSURE_RELOCATION (Scan - 1);
- count = (MANIFEST_CLOSURE_COUNT (Scan));
- word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
- dw = (word_ptr - end_ptr);
- end_ptr = (end_scan_buffer_extension (end_ptr));
- word_ptr = (end_ptr + dw);
- Scan = ((SCHEME_OBJECT *) (end_ptr - (2 * (sizeof (format_word)))));
- }
- else
- {
- BCH_START_CLOSURE_RELOCATION (Scan - 1);
- count = (MANIFEST_CLOSURE_COUNT (Scan));
- word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
- }
- end_ptr = ((char *) (MANIFEST_CLOSURE_END (Scan, count)));
+ case OPERATOR_LINKAGE_KIND:
+ case GLOBAL_OPERATOR_LINKAGE_KIND:
+ {
+ unsigned long count = (READ_OPERATOR_LINKAGE_COUNT (object));
+ char * entry = (FIRST_OPERATOR_LINKAGE_ENTRY (scan));
+ long delta;
+
+ {
+ int extend_p = (entry >= ((char *) scan_buffer_top));
+ long delta1 = (((char *) scan) - entry);
+ if (extend_p)
+ extend_scan_buffer (entry, free);
+ BCH_START_OPERATOR_RELOCATION (scan);
+ if (extend_p)
+ {
+ entry = (end_scan_buffer_extension (entry));
+ scan = ((SCHEME_OBJECT *) (entry + delta1));
+ }
+ }
+
+ /* END_OPERATOR_LINKAGE_AREA assumes that we will add
+ one to the result, so do that now. */
+ delta
+ = (((END_OPERATOR_LINKAGE_AREA (scan, count)) + 1)
+ - scan_buffer_top);
+
+ /* The operator entries are copied sequentially, but
+ extra hair is required because the entry addresses
+ are encoded. */
+ while (count > 0)
+ {
+ char * next_entry = (NEXT_LINKAGE_OPERATOR_ENTRY (entry));
+ int extend_p = (next_entry >= ((char *) scan_buffer_top));
+ SCHEME_OBJECT esaddr;
+ SCHEME_OBJECT * old_start;
+
+ /* Guarantee that the scan buffer is large enough
+ to hold the entry. */
+ if (extend_p)
+ extend_scan_buffer (next_entry, free);
+
+ /* Get the entry address. */
+ BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS (esaddr, entry);
+
+ /* Get the code-block pointer for this entry. */
+ Get_Compiled_Block
+ (old_start, (SCHEME_ADDR_TO_ADDR (esaddr)));
+
+ /* Copy the block. */
+ if (old_start < low_heap)
+ ;
+ else if (BROKEN_HEART_P (*old_start))
+ {
+ BCH_STORE_OPERATOR_LINKAGE_ADDRESS
+ ((RELOCATE_COMPILED_RAW_ADDRESS
+ (esaddr,
+ (OBJECT_ADDRESS (*old_start)),
+ old_start)),
+ entry);
+ }
+ else
+ {
+ unsigned long n_words
+ = (1 + (OBJECT_DATUM (*old_start)));
+ BCH_ALIGN_FLOAT (new_address, free);
+ TRANSPORT_VECTOR
+ (new_address, free, old_start, n_words);
+ BCH_STORE_OPERATOR_LINKAGE_ADDRESS
+ ((RELOCATE_COMPILED_RAW_ADDRESS
+ (esaddr, new_address, old_start)),
+ entry);
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+
+ if (extend_p)
+ {
+ entry = (end_scan_buffer_extension (next_entry));
+ delta -= gc_buffer_size;
+ }
+ else
+ entry = next_entry;
+
+ count -= 1;
+ }
+ scan = (scan_buffer_top + delta);
+ MAYBE_DUMP_SCAN (scan);
+ BCH_END_OPERATOR_RELOCATION (scan);
+ }
+ break;
+
+ case CLOSURE_PATTERN_LINKAGE_KIND:
+ scan += (1 + (READ_CACHE_LINKAGE_COUNT (object)));
+ MAYBE_DUMP_SCAN (scan);
+ break;
+
+ default:
+ gc_death (TERM_EXIT, "gc_loop: Unknown compiler linkage kind.",
+ scan, free);
+ /*NOTREACHED*/
+ break;
+ }
+ break;
- for ( ; ((--count) >= 0);
- (word_ptr = (NEXT_MANIFEST_CLOSURE_ENTRY (word_ptr))))
- {
- if (! ((CLOSURE_ENTRY_END (word_ptr)) > ((char *) scan_buffer_top)))
- relocate_manifest_closure (true);
- else
+ case TC_MANIFEST_CLOSURE:
+ if (gc_mode == PURE_COPY)
+ {
+ gc_death (TERM_COMPILER_DEATH,
+ "gc_loop: manifest closure in pure area",
+ scan, free);
+ /*NOTREACHED*/
+ }
{
- char * entry_end;
- long de, dw;
-
- entry_end = (CLOSURE_ENTRY_END (word_ptr));
- de = (end_ptr - entry_end);
- dw = (entry_end - word_ptr);
- extend_scan_buffer (entry_end, To);
- relocate_manifest_closure (true);
- entry_end = (end_scan_buffer_extension (entry_end));
- word_ptr = (entry_end - dw);
- end_ptr = (entry_end + de);
- }
- }
- Scan = ((SCHEME_OBJECT *) (end_ptr));
- BCH_END_CLOSURE_RELOCATION (Scan);
- break;
- }
-\f
- case_Cell:
- relocate_normal_pointer (copy_cell(), 1);
+ unsigned long count;
+ char * entry;
+ char * closure_end;
- case TC_REFERENCE_TRAP:
- if ((OBJECT_DATUM (Temp)) <= TRAP_MAX_IMMEDIATE)
- /* It is a non pointer. */
- break;
- /* It is a pair, fall through. */
- case_Pair:
- relocate_normal_pointer (copy_pair (), 2);
-
- case TC_VARIABLE:
- case_Triple:
- relocate_normal_pointer (copy_triple (), 3);
-
- case_Quadruple:
- relocate_normal_pointer (copy_quadruple (), 4);
-
- case_Aligned_Vector:
- relocate_flonum_setup ();
- goto Move_Vector;
-
- case_Vector:
- relocate_normal_setup ();
- Move_Vector:
- copy_vector (NULL);
- relocate_normal_end ();
-
- case TC_FUTURE:
- relocate_normal_setup ();
- if (!(Future_Spliceable (Temp)))
- {
- goto Move_Vector;
- }
- *Scan = (Future_Value (Temp));
- Scan -= 1;
- continue;
+ {
+ unsigned long delta = (2 * (sizeof (format_word)));
+ char * count_end = (((char *) (scan + 1)) + delta);
+ int extend_p = (count_end >= ((char *) scan_buffer_top));
+
+ /* Guarantee that the scan buffer is large enough to
+ hold the count field. */
+ if (extend_p)
+ extend_scan_buffer (count_end, free);
+
+ BCH_START_CLOSURE_RELOCATION (scan);
+ count = (MANIFEST_CLOSURE_COUNT (scan + 1));
+ entry = (FIRST_MANIFEST_CLOSURE_ENTRY (scan + 1));
+
+ if (extend_p)
+ {
+ long dw = (entry - count_end);
+ count_end = (end_scan_buffer_extension (count_end));
+ entry = (count_end + dw);
+ }
+ scan = ((SCHEME_OBJECT *) (count_end - delta));
+ }
- case TC_WEAK_CONS:
- relocate_normal_pointer (copy_weak_pair (), 2);
+ /* MANIFEST_CLOSURE_END assumes that one will be added to
+ result, so do that now. */
+ closure_end
+ = ((char *) ((MANIFEST_CLOSURE_END (scan, count)) + 1));
- default:
- GC_BAD_TYPE ("gcloop");
- /* Fall Through */
+ /* The closures are copied sequentially, but extra hair is
+ required because the code-entry pointers are encoded as
+ machine instructions. */
+ while (count > 0)
+ {
+ char * entry_end = (CLOSURE_ENTRY_END (entry));
+ int extend_p = (entry_end >= ((char *) scan_buffer_top));
+ SCHEME_OBJECT esaddr;
+ SCHEME_OBJECT * old_start;
+ long delta1 = (entry - entry_end);
+ long delta2 = (closure_end - entry_end);
+
+ /* If the closure overflows the scan buffer, extend
+ the buffer to the end of the closure. */
+ if (extend_p)
+ extend_scan_buffer (entry_end, free);
+
+ /* Extract the code-entry pointer and convert it to a
+ C pointer. */
+ BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS (esaddr, entry);
+ Get_Compiled_Block (old_start, (SCHEME_ADDR_TO_ADDR (esaddr)));
+
+ /* Copy the code entry. Use machine-specific macro to
+ update the pointer. */
+ if (old_start < low_heap)
+ ;
+ else if (BROKEN_HEART_P (*old_start))
+ BCH_STORE_CLOSURE_ENTRY_ADDRESS
+ ((RELOCATE_COMPILED_RAW_ADDRESS
+ (esaddr, (OBJECT_ADDRESS (*old_start)), old_start)),
+ entry);
+ else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ BCH_ALIGN_FLOAT (new_address, free);
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ BCH_STORE_CLOSURE_ENTRY_ADDRESS
+ ((RELOCATE_COMPILED_RAW_ADDRESS
+ (esaddr, new_address, old_start)),
+ entry);
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+
+ if (extend_p)
+ {
+ entry_end = (end_scan_buffer_extension (entry_end));
+ entry = (entry_end + delta1);
+ closure_end = (entry_end + delta2);
+ }
+
+ entry = (NEXT_MANIFEST_CLOSURE_ENTRY (entry));
+ count -= 1;
+ }
+ scan = ((SCHEME_OBJECT *) closure_end);
+ MAYBE_DUMP_SCAN (scan);
+ BCH_END_CLOSURE_RELOCATION (scan);
+ }
+ break;
- case_Non_Pointer:
- break;
- }
- }
-end_gcloop:
- (* To_ptr) = To;
- (* To_Address_ptr) = To_Address;
- return (Scan);
+ case TC_FUTURE:
+ if (gc_mode == CONSTANT_COPY)
+ {
+ scan += 1;
+ break;
+ }
+ {
+ SCHEME_OBJECT * old_start = (OBJECT_ADDRESS (object));
+ if (old_start < low_heap)
+ scan += 1;
+ else if (BROKEN_HEART_P (*old_start))
+ (*scan++) = (MAKE_OBJECT_FROM_OBJECTS (object, (*old_start)));
+ else if (Future_Spliceable (object))
+ (*scan) = (Future_Value (object));
+ else
+ {
+ unsigned long n_words = (1 + (OBJECT_DATUM (*old_start)));
+ TRANSPORT_VECTOR (new_address, free, old_start, n_words);
+ (*scan++) = (OBJECT_NEW_ADDRESS (object, new_address));
+ (*old_start) = (MAKE_BROKEN_HEART (new_address));
+ new_address += n_words;
+ }
+ }
+ break;
+
+ default:
+ GC_BAD_TYPE ("gc_loop", object);
+ scan += 1;
+ break;
+ }
+ }
+ end_gc_loop:
+ (*free_ptr) = free;
+ (*new_address_ptr) = new_address;
+ if (require_normal_end && (scan != free))
+ {
+ gc_death (TERM_BROKEN_HEART, "gc_loop ended too early", scan, free);
+ /*NOTREACHED*/
+ }
+ return (scan);
}
/* -*-C-*-
-$Id: bchmmg.c,v 9.96 2000/11/28 05:19:02 cph Exp $
+$Id: bchmmg.c,v 9.97 2000/12/05 21:23:42 cph Exp $
Copyright (c) 1987-2000 Massachusetts Institute of Technology
/* Memory management top level. Garbage collection to disk. */
#include "scheme.h"
-#include "memmag.h"
#include "prims.h"
+#include "memmag.h"
#include "option.h"
-#include "oscond.h"
-#include "posixtyp.h"
-
-#ifdef _POSIX
-#include <unistd.h>
-#endif
+#include "osenv.h"
+#include "osfs.h"
-#ifdef DOS386
-# include <string.h>
-# include "msdos.h"
-# define SUB_DIRECTORY_DELIMITER '\\'
+#ifdef __unix__
+# include "ux.h"
+# define SUB_DIRECTORY_DELIMITER '/'
+/* This makes for surprising behavior: */
+/* # define UNLINK_BEFORE_CLOSE */
#endif
-#ifdef WINNT
+#ifdef __WIN32__
# include "nt.h"
# define SUB_DIRECTORY_DELIMITER '\\'
-# define ASSUME_NORMAL_GC_FILE
-#endif
-
-#ifdef _OS2
-#include "os2.h"
-#define SUB_DIRECTORY_DELIMITER '\\'
-#define ASSUME_NORMAL_GC_FILE
-#if defined(__IBMC__) || defined(__WATCOMC__) || defined(__EMX__)
-#include <io.h>
-#include <sys\stat.h>
#endif
#ifndef F_OK
#define F_OK 0
#endif
#endif
-#ifndef SUB_DIRECTORY_DELIMITER
-# include "ux.h"
-# define SUB_DIRECTORY_DELIMITER '/'
-# define UNLINK_BEFORE_CLOSE
- extern int EXFUN (unlink, (CONST char *));
+#ifdef __OS2__
+# include "os2.h"
+# define SUB_DIRECTORY_DELIMITER '\\'
+# if defined(__IBMC__) || defined(__WATCOMC__) || defined(__EMX__)
+# include <io.h>
+# include <sys\stat.h>
+# endif
+# ifndef F_OK
+# define F_OK 0
+# define X_OK 1
+# define W_OK 2
+# define R_OK 4
+# endif
#endif
#include "bchgcc.h"
# define SEEK_SET 0
#endif
-#ifdef HAVE_SYSV_SHARED_MEMORY
+#ifdef USE_SYSV_SHARED_MEMORY
# define RECORD_GC_STATISTICS
#endif
#define MILLISEC * 1000
* virtual_scan_base;
static char
- * gc_file_name = ((char *) NULL),
- gc_file_name_buffer[FILE_NAME_LENGTH];
+ * gc_file_name = 0;
CONST char
- * drone_file_name = ((char *) NULL);
+ * drone_file_name = 0;
static int
keep_gc_file_p = 0,
return (1);
}
-#ifdef WINNT
+#ifdef __WIN32__
#include <windows.h>
int
return (0);
}
-#else /* not WINNT */
-#ifdef _OS2
-
-#define INCL_WIN
-#include <os2.h>
+#else /* not __WIN32__ */
+#ifdef __OS2__
int
io_error_retry_p (char * operation_name, char * noise)
}
}
-#else /* not _OS2 */
+#else /* not __OS2__ */
extern char EXFUN (userio_choose_option,
(CONST char *, CONST char *, CONST char **));
}
}
-#endif /* not _OS2 */
-#endif /* not WINNT */
+#endif /* not __OS2__ */
+#endif /* not __WIN32__ */
\f
static int
DEFUN (verify_write, (position, size, success),
AND char * noise AND Boolean * success)
{
if (((verify_write (position, nbytes, success)) != -1)
- && ((retrying_file_operation (write,
+ && ((retrying_file_operation (((file_operation_t *) write),
gc_file,
from,
position,
long position AND char * to AND long nbytes
AND char * noise AND Boolean * success)
{
- (void) (retrying_file_operation (read,
+ (void) (retrying_file_operation (((file_operation_t *) read),
gc_file,
to,
position,
((success == ((Boolean *) NULL))
? io_error_retry_p
: io_error_always_abort)));
- return;
}
\f
static int
return (-1);
}
-#ifdef SIGCONT
-static void
-DEFUN (continue_running, (sig), int sig)
-{
- RE_INSTALL_HANDLER (SIGCONT, continue_running);
- return;
-}
-#endif
-
struct bch_GC_statistic
{
char * name;
#endif
\f
-#ifdef HAVE_SYSV_SHARED_MEMORY
+#ifdef USE_SYSV_SHARED_MEMORY
#ifdef RECORD_GC_STATISTICS
#define GET_SLEEP_DELTA() default_sleep_period
#define SET_SLEEP_DELTA(value) default_sleep_period = (value)
-#ifdef FD_SET
-#define SELECT_TYPE fd_set
-#else
-#define SELECT_TYPE int
-#define FD_SETSIZE ((sizeof (int)) * CHAR_BIT)
-#define FD_SET(n, p) ((*(p)) |= (1 << (n)))
-#define FD_CLR(n, p) ((*(p)) &= ~(1 << (n)))
-#define FD_ISSET(n, p) (((*(p)) & (1 << (n))) != 0)
-#define FD_ZERO(p) ((*(p)) = 0)
-extern int EXFUN (select,
- (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
- struct timeval *));
-#endif
-
static void
DEFUN (sleep_awaiting_drones, (microsec, mask),
unsigned int microsec AND unsigned long mask)
{
- int dummy, saved_errno;
- struct timeval timeout;
-
- dummy = 0;
- timeout.tv_sec = 0;
- timeout.tv_usec = microsec;
+ int saved_errno;
+ int retval;
*wait_mask = mask;
- dummy = (select (0,
- ((SELECT_TYPE *) &dummy),
- ((SELECT_TYPE *) &dummy),
- ((SELECT_TYPE *) &dummy),
- &timeout));
+#ifdef HAVE_POLL
+ retval = (poll (0, 0, (microsec / 1000)));
+#else
+ {
+ int dummy = 0;
+ struct timeval timeout;
+ timeout.tv_sec = 0;
+ timeout.tv_usec = microsec;
+ retval
+ = (select (0,
+ ((SELECT_TYPE *) &dummy),
+ ((SELECT_TYPE *) &dummy),
+ ((SELECT_TYPE *) &dummy),
+ &timeout));
+ }
+#endif
*wait_mask = ((unsigned long) 0);
saved_errno = errno;
- if ((dummy == -1) && (saved_errno == EINTR))
+ if ((retval == -1) && (saved_errno == EINTR))
STATISTICS_INCR (sleeps_interrupted);
- return;
}
#ifndef _SUNOS4
}
#endif /* _SUNOS4 */
+
+#ifdef SIGCONT
+static void
+DEFUN (continue_running, (sig), int sig)
+{
+ RE_INSTALL_HANDLER (SIGCONT, continue_running);
+}
+#endif
\f
static void
DEFUN (start_gc_drones, (first_drone, how_many, restarting),
int first_drone AND int how_many AND int restarting)
{
pid_t pid;
- long signal_mask;
char arguments[512];
struct drone_info *drone;
char
}
else
{
-\f
sigset_t old_mask, new_mask;
UX_sigemptyset (&new_mask);
malloc_size = ((n_gc_drones == 0)
? shared_size
: (first_time_p ? MALLOC_SPACE : 0));
-\f
+
if (malloc_size > 0)
{
malloc_memory = ((char *) (malloc (malloc_size)));
free (malloc_memory);
malloc_memory = ((char *) NULL);
}
-\f
+
gc_buffers = ((struct buffer_info *) (shared_memory + buffer_space));
gc_drones = ((struct drone_info *) (gc_buffers + n_gc_buffers));
drone_version = ((unsigned long *) (gc_drones + n_gc_drones));
UX_sigaddset ((&mask), SIGCONT);
UX_sigprocmask (SIG_UNBLOCK, (&mask), 0);
}
-\f
+
for (cntr = 0, entry = gc_read_queue;
cntr < read_overlap;
cntr++, entry++)
drone_mask = ((unsigned long) 0);
for (cntr = 0, entry = queue; cntr < queue_size; cntr++, entry++)
{
-\f
if (entry->state == entry_idle)
queue_index = cntr;
else if ((entry->buffer)->position == position)
scheme_program_name);
Microcode_Termination (TERM_GC_OUT_OF_SPACE);
/*NOTREACHED*/
+ return (0);
}
static struct buffer_info *
STATISTICS_INCR (reads_pending);
goto buffer_available;
}
-\f
+
case buffer_queued:
STATISTICS_INCR (reads_queued);
goto buffer_available;
#define LOAD_BUFFER(buffer, position, size, noise) \
buffer = (read_buffer (position, size, noise))
-
-#endif /* HAVE_SYSV_SHARED_MEMORY */
-
-
-
-#ifndef GC_BUFFER_ALLOCATION
+\f
+#else /* not USE_SYSV_SHARED_MEMORY */
static struct buffer_info
* gc_disk_buffer_1,
#define INITIALIZE_IO() do { } while (0)
#define AWAIT_IO_COMPLETION() do { } while (0)
-\f
+
#define INITIAL_FREE_BUFFER() gc_disk_buffer_1
#define INITIAL_SCAN_BUFFER() OTHER_BUFFER(free_buffer)
/* (gc_disk_buffer_1 - (gc_disk_buffer_2 - (buffer))) does not work
because scan_buffer is not initialized until after scanning
- constant space.
-*/
+ constant space. */
#define OTHER_BUFFER(buffer) (((buffer) == gc_disk_buffer_1) \
? gc_disk_buffer_2 \
#define DUMP_BUFFER(buffer, position, size, successp, noise) \
write_data (((char *) buffer), position, size, noise, successp)
-#endif /* GC_BUFFER_ALLOCATION */
+#endif /* not USE_SYSV_SHARED_MEMORY */
+\f
+#define DUMP_SCAN_BUFFER(success) \
+ DUMP_BUFFER (scan_buffer, scan_position, gc_buffer_bytes, \
+ success, "the scan buffer")
+
+#define DUMP_FREE_BUFFER(success) \
+ DUMP_BUFFER (free_buffer, free_position, gc_buffer_bytes, \
+ success, "the free buffer")
+
+#define LOAD_SCAN_BUFFER() \
+ LOAD_BUFFER (scan_buffer, scan_position, gc_buffer_bytes, \
+ "the scan buffer")
+
+#define LOAD_FREE_BUFFER() \
+ LOAD_BUFFER (free_buffer, free_position, gc_buffer_bytes, \
+ "the free buffer")
static int
DEFUN (next_exponent_of_two, (value), int value)
;
return (exponent);
}
-
+\f
/* Hacking the gc file */
static int
saved_gc_file = -1,
saved_read_overlap,
saved_write_overlap;
-\f
+
static long
saved_start_position,
saved_end_position;
static void
DEFUN (close_gc_file, (unlink_p), int unlink_p)
{
-#ifdef F_ULOCK
+#ifdef HAVE_LOCKF
if (gc_file != -1)
- {
- (void) (lseek (gc_file, gc_file_start_position, SEEK_SET));
- (void) (lockf (gc_file, F_ULOCK,
- (gc_file_end_position - gc_file_start_position)));
- }
+ {
+ if ((lseek (gc_file, gc_file_start_position, SEEK_SET)) < 0)
+ perror ("lseek");
+ if ((lockf (gc_file, F_ULOCK,
+ (gc_file_end_position - gc_file_start_position)))
+ < 0)
+ perror ("lockf");
+ }
#endif
if ((gc_file != -1) && ((close (gc_file)) == -1))
outf_error ("\n%s (close_gc_file): error: GC file = \"%s\"; errno = %s.\n",
gc_file = -1;
if (!keep_gc_file_p && unlink_p)
unlink (gc_file_name);
- gc_file_name = ((char *) NULL);
+ OS_free (gc_file_name);
+ gc_file_name = 0;
keep_gc_file_p = 0;
- return;
}
\f
#define EMPTY_STRING_P(string) \
/*NOTREACHED*/
}
-extern char * EXFUN (mktemp, (char *));
-#ifndef _POSIX
+char *
+DEFUN (make_gc_file_name, (suffix), CONST char * suffix)
+{
+ unsigned int s = (strlen (suffix));
+ if ((option_gc_file[0]) == SUB_DIRECTORY_DELIMITER)
+ {
+ unsigned int n
+ = (((strrchr (option_gc_file, SUB_DIRECTORY_DELIMITER))
+ - option_gc_file)
+ + 1);
+ char * result = (OS_malloc (n + s + 1));
+ strncpy (result, option_gc_file, n);
+ (result[n]) = '\0';
+ strcat (result, suffix);
+ return (result);
+ }
+ {
+ unsigned int l = (strlen (option_gc_directory));
+ if ((option_gc_directory [l - 1]) == SUB_DIRECTORY_DELIMITER)
+ {
+ unsigned int n = l;
+ char * result = (OS_malloc (n + s + 1));
+ sprintf (result, "%s%s", option_gc_directory, suffix);
+ return (result);
+ }
+ else
+ {
+ unsigned int n = (l + 1);
+ char * result = (OS_malloc (n + s + 1));
+ sprintf (result, "%s%c%s",
+ option_gc_directory, SUB_DIRECTORY_DELIMITER, suffix);
+ return (result);
+ }
+ }
+}
+
+int
+DEFUN (allocate_gc_file, (name), char * name)
+{
+ /* `name' must end in 6 `X' characters. */
+ char * exxes = (name + ((strlen (name)) - 6));
+ unsigned int n = 0;
+
+ while (n < 1000000)
+ {
+ sprintf (exxes, "%06d", n);
+ if (OS_file_touch (name))
+ return (1);
+ n += 1;
+ }
+ return (0);
+}
+
+void
+DEFUN (protect_gc_file_name, (name), CONST char * name)
+{
+ CONST char ** p = (dstack_alloc (sizeof (char *)));
+ (*p) = name;
+ transaction_record_action (tat_always, OS_free, p);
+}
+
+#ifndef _POSIX_VERSION
extern off_t EXFUN (lseek, (int, off_t, int));
#endif
static void
DEFUN (open_gc_file, (size, unlink_p),
- long size AND int unlink_p)
+ long size AND
+ int unlink_p)
{
struct stat file_info;
- int position, flags;
+ int flags;
Boolean temp_p, exists_p;
- gc_file_name = &gc_file_name_buffer[0];
- if (option_gc_file[0] == SUB_DIRECTORY_DELIMITER)
- strcpy (gc_file_name, option_gc_file);
- else
+ gc_file_name
+ = (make_gc_file_name
+ (((option_gc_file[0]) == SUB_DIRECTORY_DELIMITER)
+ ? ((strrchr (option_gc_file, SUB_DIRECTORY_DELIMITER)) + 1)
+ : option_gc_file));
+
{
- position = (strlen (option_gc_directory));
- if ((position == 0) ||
- (option_gc_directory[position - 1] != SUB_DIRECTORY_DELIMITER))
- sprintf (gc_file_name, "%s%c%s",
- option_gc_directory, SUB_DIRECTORY_DELIMITER, option_gc_file);
+ unsigned int n = (strlen (option_gc_file));
+ if ((n >= 6) && ((strcmp ((option_gc_file + (n - 6)), "XXXXXX")) == 0))
+ {
+ if (!allocate_gc_file (gc_file_name))
+ {
+ outf_fatal
+ ("%s: Unable to allocate a temporary file for the spare heap.\n",
+ scheme_program_name);
+ termination_open_gc_file (0, 0);
+ /*NOTREACHED*/
+ }
+ temp_p = true;
+ }
else
- sprintf (gc_file_name, "%s%s", option_gc_directory, option_gc_file);
+ temp_p = false;
}
- /* mktemp supposedly only clobbers Xs from the end.
- If the string does not end in Xs, it should be untouched.
- This presents a quoting problem, but...
- Unfortunately, it seems to clobber the string when there are no Xs.
- */
-
- temp_p = false;
- position = (strlen (option_gc_file));
- if ((position >= 6)
- && ((strncmp ((option_gc_file + (position - 6)), "XXXXXX", 6)) == 0))
- {
- char * gc_temp = (mktemp (gc_file_name));
- if (EMPTY_STRING_P (gc_temp))
- {
- outf_fatal
- ("%s (open_gc_file): \
- Unable to allocate a temporary file for the spare heap.\n",
- scheme_program_name);
- termination_open_gc_file (((char *) NULL), ((char *) NULL));
- }
- temp_p = true;
- }
-\f
flags = GC_FILE_FLAGS;
gc_file_start_position = (ALIGN_UP_TO_IO_PAGE (option_gc_start_position));
gc_file_end_position = option_gc_end_position;
scheme_program_name,
option_gc_start_position, gc_file_start_position,
option_gc_end_position, gc_file_end_position);
- termination_open_gc_file (((char *) NULL), ((char *) NULL));
+ termination_open_gc_file (0, 0);
}
absolute_gc_file_end_position = gc_file_end_position;
}
else
{
-#ifdef ASSUME_NORMAL_GC_FILE
- /* Assume that it will be a normal file. */
- exists_p = true;
- can_dump_directly_p = true;
-#else
+#ifdef __unix__
/* If it is S_IFCHR, it should determine the IO block
size and make sure that it will work.
I don't know how to do that.
}
else
can_dump_directly_p = true;
-#endif /* not ASSUME_NORMAL_GC_FILE */
+#else
+ /* Assume that it will be a normal file. */
+ exists_p = true;
+ can_dump_directly_p = true;
+#endif
}
-\f
+
gc_file = (open (gc_file_name, flags, GC_FILE_MASK));
if (gc_file == -1)
{
-#if defined(DOS386) || defined(WINNT) || defined(_OS2)
+#ifndef __unix__
/* errno does not give sufficient information except under unix. */
int saved_errno = errno;
}
else
errno = saved_errno;
-#endif /* defined(DOS386) || defined(WINNT) || defined(_OS2) */
+#endif /* not __unix__ */
termination_open_gc_file ("open", ((char *) NULL));
}
- keep_gc_file_p = (option_gc_keep || (exists_p && (! temp_p)));
+ keep_gc_file_p = (option_gc_keep || (exists_p && (!temp_p)));
#ifdef UNLINK_BEFORE_CLOSE
if (!keep_gc_file_p && unlink_p)
- (void) (unlink (gc_file_name));
+ unlink (gc_file_name);
#endif
#ifdef HAVE_PREALLOC
if (!exists_p)
- {
- extern int EXFUN (prealloc, (int, off_t));
+ prealloc (gc_file, ((unsigned int) gc_file_end_position));
+#endif
- (void) (prealloc (gc_file, ((unsigned int) gc_file_end_position)));
- }
-#endif /* HAVE_PREALLOC */
-\f
-#ifdef F_TLOCK
+#ifdef HAVE_LOCKF
if (exists_p)
- {
- extern int EXFUN (locfk, (int, int, long));
-
- if ((lseek (gc_file, gc_file_start_position, SEEK_SET)) == -1)
- termination_open_gc_file ("lseek", ((char *) NULL));
+ {
+ if ((lseek (gc_file, gc_file_start_position, SEEK_SET)) < 0)
+ termination_open_gc_file ("lseek", ((char *) NULL));
- if ((lockf (gc_file, F_TLOCK, size)) == -1)
- termination_open_gc_file
- ("lockf",
- "The GC file is probably being used by another process");
- }
-#endif /* F_TLOCK */
+ if ((lockf (gc_file, F_TLOCK, size)) < 0)
+ termination_open_gc_file
+ ("lockf",
+ "The GC file is probably being used by another process");
+ }
+#endif
gc_file_current_position = -1; /* Unknown position */
-#ifndef ASSUME_NORMAL_GC_FILE
+#ifdef __unix__
/* Determine whether it is a seekable file. */
if (exists_p && ((file_info.st_mode & S_IFMT) == S_IFCHR))
{
-#if defined(F_GETFL) && defined(F_SETFL) && defined(O_NONBLOCK)
- int flags;
+#ifdef HAVE_FCNTL
+ int fcntl_flags;
#endif
Boolean ignore;
static char message[] = "This is a test message to the GC file.\n";
(IO_PAGE_SIZE - (sizeof (message))));
(* (buffer + (IO_PAGE_SIZE - 1))) = '\n';
-#if defined(F_GETFL) && defined(F_SETFL) && defined(O_NONBLOCK)
- if ((flags = (fcntl (gc_file, F_GETFL, 0))) != -1)
- (void) (fcntl (gc_file, F_SETFL, (flags | O_NONBLOCK)));
+#ifdef HAVE_FCNTL
+ fcntl_flags = (fcntl (gc_file, F_GETFL, 0));
+ if (fcntl_flags != (-1))
+ fcntl (gc_file, F_SETFL, (fcntl_flags | O_NONBLOCK));
#endif
write_data (buffer,
scheme_program_name, gc_file_name);
termination_open_gc_file (((char *) NULL), ((char *) NULL));
}
-#if defined(F_GETFL) && defined(F_SETFL) && defined(O_NONBLOCK)
- if (flags != -1)
- (void) (fcntl (gc_file, F_SETFL, (flags | O_NONBLOCK)));
+#ifdef HAVE_FCNTL
+ if (fcntl_flags != (-1))
+ fcntl (gc_file, F_SETFL, fcntl_flags);
#endif
}
-#endif /* not ASSUME_NORMAL_GC_FILE */
- return;
+#endif /* __unix__ */
}
\f
#define CONSTANT_SPACE_FUDGE 128
-extern void EXFUN (reset_allocator_parameters, (void));
-extern Boolean EXFUN (update_allocator_parameters, (SCHEME_OBJECT *));
-
Boolean
DEFUN (update_allocator_parameters, (ctop), SCHEME_OBJECT * ctop)
{
diff = ((free_position - pre_read_position) >> gc_buffer_byte_shift);
if (diff >= read_overlap)
- DUMP_BUFFER (free_buffer, free_position, gc_buffer_bytes,
- success, "the free buffer");
+ DUMP_FREE_BUFFER (success);
else
{
ENQUEUE_READY_BUFFER (free_buffer, free_position, gc_buffer_bytes);
}
\f
static void
-DEFUN (reload_scan_buffer, (skip), int skip)
+DEFUN (reload_scan_buffer, (skip), unsigned long skip)
{
-
scan_position += (skip << gc_buffer_byte_shift);
virtual_scan_pointer += (skip << gc_buffer_shift);
scan_buffer_top = free_buffer_top;
return;
}
- LOAD_BUFFER (scan_buffer, scan_position,
- gc_buffer_bytes, "the scan buffer");
+ LOAD_SCAN_BUFFER ();
scan_buffer_bottom = (GC_BUFFER_BOTTOM (scan_buffer));
scan_buffer_top = (GC_BUFFER_TOP (scan_buffer));
*scan_buffer_top = (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, scan_buffer_top));
if (read_overlap > 0)
schedule_pre_reads ();
- return;
}
SCHEME_OBJECT *
-DEFUN (dump_and_reload_scan_buffer, (number_to_skip, success),
- long number_to_skip AND Boolean * success)
+DEFUN (dump_and_reload_scan_buffer, (end, success),
+ SCHEME_OBJECT * end AND
+ Boolean * success)
{
- DUMP_BUFFER (scan_buffer, scan_position, gc_buffer_bytes,
- success, "the scan buffer");
- reload_scan_buffer (1 + number_to_skip);
- return (scan_buffer_bottom);
+ unsigned long number_to_skip = (end - scan_buffer_top);
+ DUMP_SCAN_BUFFER (success);
+ reload_scan_buffer (1 + (number_to_skip >> gc_buffer_shift));
+ return (scan_buffer_bottom + (number_to_skip & gc_buffer_mask));
}
\f
SCHEME_OBJECT *
-DEFUN (dump_and_reset_free_buffer, (overflow, success),
- fast long overflow AND Boolean * success)
+DEFUN (dump_and_reset_free_buffer, (current_free, success),
+ SCHEME_OBJECT * current_free AND
+ Boolean * success)
{
- Boolean buffer_overlap_p, same_buffer_p;
- fast SCHEME_OBJECT *into, *from;
-
- from = free_buffer_top;
- buffer_overlap_p = extension_overlap_p;
- same_buffer_p = (scan_buffer == free_buffer);
+ unsigned long overflow = (current_free - free_buffer_top);
+ SCHEME_OBJECT * from = free_buffer_top;
+ Boolean buffer_overlap_p = extension_overlap_p;
+ Boolean same_buffer_p = (scan_buffer == free_buffer);
if (read_overlap > 0)
- {
- if (buffer_overlap_p)
{
- extension_overlap_p = false;
- next_scan_buffer = free_buffer;
+ if (buffer_overlap_p)
+ {
+ extension_overlap_p = false;
+ next_scan_buffer = free_buffer;
+ }
+ else if (!same_buffer_p)
+ enqueue_free_buffer (success);
}
- else if (!same_buffer_p)
- enqueue_free_buffer (success);
- }
else if (!same_buffer_p)
- DUMP_BUFFER (free_buffer, free_position, gc_buffer_bytes,
- success, "the free buffer");
+ DUMP_FREE_BUFFER (success);
/* Otherwise there is no need to dump now, it will be dumped
when scan is dumped. Note that the next buffer may be dumped
before this one, but there should be no problem lseeking past the
- end of file.
- */
-
+ end of file. */
free_position += gc_buffer_bytes;
free_buffer = (OTHER_BUFFER (scan_buffer));
free_buffer_bottom = (GC_BUFFER_BOTTOM (free_buffer));
free_buffer_top = (GC_BUFFER_TOP (free_buffer));
-
- for (into = free_buffer_bottom; --overflow >= 0; )
- *into++ = *from++;
-
- if (same_buffer_p && !buffer_overlap_p)
- *scan_buffer_top =
- (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, scan_buffer_top));
- return (into);
+ {
+ SCHEME_OBJECT * into = free_buffer_bottom;
+ SCHEME_OBJECT * end = (into + overflow);
+ while (into < end)
+ (*into++) = (*from++);
+ if (same_buffer_p && (!buffer_overlap_p))
+ (*scan_buffer_top)
+ = (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, scan_buffer_top));
+ return (into);
+ }
}
\f
/* These utilities are needed when pointers fall accross window boundaries.
void
DEFUN (extend_scan_buffer, (to_where, current_free),
- fast char * to_where AND SCHEME_OBJECT * current_free)
+ char * to_where AND
+ SCHEME_OBJECT * current_free)
{
fast char * source, * dest;
long new_scan_position = (scan_position + gc_buffer_bytes);
*/
SCHEME_OBJECT old, new;
fast char * source, * dest, * limit;
-\f
+
extension_overlap_p = false;
source = ((char *) scan_buffer_top);
old = (* ((SCHEME_OBJECT *) source));
limit = (source + extension_overlap_length);
- dest = ((char *) (dump_and_reload_scan_buffer (0, ((Boolean *) NULL))));
+ dest = ((char *) (dump_and_reload_scan_buffer (scan_buffer_top, 0)));
/* The following is only necesary if we are reusing the scan buffer. */
new = (* scan_buffer_top);
(* ((SCHEME_OBJECT *) source)) = old;
source = scan_buffer_top;
limit = (source + gc_extra_buffer_size);
- DUMP_BUFFER (scan_buffer, scan_position, gc_buffer_bytes,
- ((Boolean *) NULL), "the scan buffer");
+ DUMP_SCAN_BUFFER (0);
scan_position += gc_buffer_bytes;
virtual_scan_pointer += gc_buffer_size;
limit = (source + extension_overlap_length);
dest = ((char *) (GC_BUFFER_BOTTOM (next_scan_buffer)));
result = (dest + (to_relocate - source));
-\f
+
while (source < limit)
*dest++ = *source++;
- DUMP_BUFFER (scan_buffer, scan_position, gc_buffer_bytes,
- ((Boolean *) NULL), "the scan buffer");
+ DUMP_SCAN_BUFFER (0);
scan_position += gc_buffer_bytes;
virtual_scan_pointer += gc_buffer_size;
for (to = free_buffer_bottom, bufend = free_buffer_top; to != bufend; )
*to++ = *from++;
- (void) (dump_and_reset_free_buffer (0, success));
+ (void) (dump_and_reset_free_buffer (to, success));
}
}
return (free_buffer_bottom);
(state -> scan_position) = scan_position;
(state -> scan_offset) = (scan - scan_buffer_bottom);
if (scan_position != free_position)
- DUMP_BUFFER (scan_buffer, scan_position, gc_buffer_bytes,
- 0, "the scan buffer");
+ DUMP_SCAN_BUFFER (0);
reset_scan_buffer ();
}
scan_buffer = (OTHER_BUFFER (free_buffer));
scan_buffer_bottom = (GC_BUFFER_BOTTOM (scan_buffer));
scan_buffer_top = (GC_BUFFER_TOP (scan_buffer));
- LOAD_BUFFER (scan_buffer, scan_position, gc_buffer_bytes,
- "the scan buffer");
+ LOAD_SCAN_BUFFER ();
}
return (scan_buffer_bottom + (state -> scan_offset));
}
void
DEFUN (end_transport, (success), Boolean * success)
{
- DUMP_BUFFER (scan_buffer, scan_position, gc_buffer_bytes,
- success, "the final scan buffer");
+ DUMP_SCAN_BUFFER (success);
scan_position += gc_buffer_bytes;
virtual_scan_pointer += gc_buffer_size;
free_position = scan_position;
*/
static void
-DEFUN_VOID (pre_read_weak_pair_buffers)
+DEFUN (pre_read_weak_pair_buffers, (low_heap), SCHEME_OBJECT * low_heap)
{
SCHEME_OBJECT next, * pair_addr, * obj_addr;
long position, last_position;
{
pair_addr = (OBJECT_ADDRESS (next));
obj_addr = (OBJECT_ADDRESS (*pair_addr++));
- if (! (obj_addr < Constant_Top))
+ if (! (obj_addr < low_heap))
{
position = (obj_addr - aligned_heap);
position = (position >> gc_buffer_shift);
}
\f
static void
-DEFUN (initialize_new_space_buffer, (chain), SCHEME_OBJECT chain)
+DEFUN (initialize_new_space_buffer, (chain, low_heap),
+ SCHEME_OBJECT chain AND
+ SCHEME_OBJECT * low_heap)
{
if (read_overlap == 0)
{
weak_pair_buffer = ((struct buffer_info *) NULL);
weak_pair_buffer_position = -1;
weak_buffer_pre_read_count = 0;
- pre_read_weak_pair_buffers ();
+ pre_read_weak_pair_buffers (low_heap);
}
- return;
}
static void
}
static SCHEME_OBJECT *
-DEFUN (guarantee_in_memory, (addr), SCHEME_OBJECT * addr)
+DEFUN (guarantee_in_memory, (addr, low_heap),
+ SCHEME_OBJECT * addr AND
+ SCHEME_OBJECT * low_heap)
{
long position, offset;
- if (addr < Constant_Top)
+ if (addr < low_heap)
return (addr);
position = (addr - aligned_heap);
if (weak_pair_break != EMPTY_WEAK_CHAIN)
{
weak_buffer_pre_read_count -= 1;
- pre_read_weak_pair_buffers ();
+ pre_read_weak_pair_buffers (low_heap);
}
}
return ((GC_BUFFER_BOTTOM (weak_pair_buffer)) + offset);
*/
static SCHEME_OBJECT
-DEFUN (update_weak_pointer, (Temp), SCHEME_OBJECT Temp)
+DEFUN (update_weak_pointer, (Temp, low_heap),
+ SCHEME_OBJECT Temp AND
+ SCHEME_OBJECT * low_heap)
{
SCHEME_OBJECT * Old;
case GC_Quadruple:
case GC_Vector:
Old = (OBJECT_ADDRESS (Temp));
- if (Old < Constant_Top)
+ if (Old < low_heap)
return (Temp);
if ((OBJECT_TYPE (*Old)) == TC_BROKEN_HEART)
case GC_Compiled:
Old = (OBJECT_ADDRESS (Temp));
- if (Old < Constant_Top)
+ if (Old < low_heap)
return (Temp);
Compiled_BH (false, { return Temp; });
return (SHARP_F);
}
void
-DEFUN_VOID (fix_weak_chain_1)
+DEFUN (fix_weak_chain_1, (low_heap), SCHEME_OBJECT * low_heap)
{
fast SCHEME_OBJECT chain, * old_weak_cell, * scan, * ptr, * limit;
chain = Weak_Chain;
- initialize_new_space_buffer (chain);
+ initialize_new_space_buffer (chain, low_heap);
limit = Stack_Pointer;
for (ptr = weak_pair_stack_ptr; ptr < limit ; ptr += 2)
- *ptr = (update_weak_pointer (*ptr));
+ *ptr = (update_weak_pointer (*ptr, low_heap));
while (chain != EMPTY_WEAK_CHAIN)
{
old_weak_cell = (OBJECT_ADDRESS (Weak_Chain));
- scan = (guarantee_in_memory (OBJECT_ADDRESS (*old_weak_cell++)));
+ scan
+ = (guarantee_in_memory ((OBJECT_ADDRESS (*old_weak_cell++)), low_heap));
Weak_Chain = (* old_weak_cell);
- *scan = (update_weak_pointer
- (MAKE_OBJECT_FROM_OBJECTS (Weak_Chain, (* scan))));
+ *scan
+ = (update_weak_pointer
+ ((MAKE_OBJECT_FROM_OBJECTS (Weak_Chain, (* scan))), low_heap));
Weak_Chain = (OBJECT_NEW_TYPE (TC_NULL, Weak_Chain));
}
flush_new_space_buffer ();
*free_buffer++ = Fluid_Bindings;
skip = (free_buffer - initial_free_buffer);
if (free_buffer >= free_buffer_top)
- free_buffer =
- (dump_and_reset_free_buffer ((free_buffer - free_buffer_top),
- NULL));
+ free_buffer = (dump_and_reset_free_buffer (free_buffer, 0));
* free_buffer_ptr = free_buffer;
return (skip);
}
DEFUN (GC, (weak_pair_transport_initialized_p),
int weak_pair_transport_initialized_p)
{
- SCHEME_OBJECT
- * root, * result, * end_of_constant_area,
- the_precious_objects, * root2,
- * free_buffer, * block_start, * saved_ctop;
+ SCHEME_OBJECT * root;
+ SCHEME_OBJECT * end_of_constant_area;
+ SCHEME_OBJECT the_precious_objects;
+ SCHEME_OBJECT * root2;
+ SCHEME_OBJECT * free_buffer;
+ SCHEME_OBJECT * block_start;
+ SCHEME_OBJECT * saved_ctop;
long skip_length;
saved_ctop = Constant_Top;
&& (update_allocator_parameters (Free_Constant)))
Constant_Top = saved_ctop;
- if (! weak_pair_transport_initialized_p)
+ if (!weak_pair_transport_initialized_p)
initialize_weak_pair_transport (Stack_Bottom);
free_buffer = (initialize_free_buffer ());
end_of_constant_area = (CONSTANT_AREA_END ());
the_precious_objects = (Get_Fixed_Obj_Slot (Precious_Objects));
root = Free;
-\f
+
/* The 4 step GC */
Free += (GC_relocate_root (&free_buffer));
- result = (GCLoop ((CONSTANT_AREA_START ()), &free_buffer, &Free));
- if (result != end_of_constant_area)
{
- outf_fatal ("\n%s (GC): The Constant Space scan ended too early.\n",
- scheme_program_name);
- Microcode_Termination (TERM_EXIT);
- /*NOTREACHED*/
+ SCHEME_OBJECT * new_scan
+ = (gc_loop ((CONSTANT_AREA_START ()), (&free_buffer), (&Free),
+ Constant_Top, NORMAL_GC, 0));
+ if (new_scan != end_of_constant_area)
+ {
+ gc_death (TERM_EXIT, "gc_loop ended too early", new_scan, free_buffer);
+ /*NOTREACHED*/
+ }
}
- result = (GCLoop (((initialize_scan_buffer (block_start)) + skip_length),
- &free_buffer, &Free));
- if (free_buffer != result)
{
- outf_fatal ("\n%s (GC): The Heap scan ended too early.\n",
- scheme_program_name);
- Microcode_Termination (TERM_EXIT);
- /*NOTREACHED*/
- }
+ SCHEME_OBJECT * scan
+ = (gc_loop (((initialize_scan_buffer (block_start)) + skip_length),
+ (&free_buffer), (&Free), Constant_Top, NORMAL_GC, 1));
- root2 = Free;
- *free_buffer++ = the_precious_objects;
- Free += (free_buffer - result);
- if (free_buffer >= free_buffer_top)
- free_buffer =
- (dump_and_reset_free_buffer ((free_buffer - free_buffer_top), NULL));
+ root2 = Free;
+ (*free_buffer++) = the_precious_objects;
+ Free += 1;
+ if (free_buffer >= free_buffer_top)
+ free_buffer = (dump_and_reset_free_buffer (free_buffer, 0));
- result = (GCLoop (result, &free_buffer, &Free));
- if (free_buffer != result)
- {
- outf_fatal ("\n%s (GC): The Precious Object scan ended too early.\n",
- scheme_program_name);
- Microcode_Termination (TERM_EXIT);
- /*NOTREACHED*/
+ gc_loop (scan, (&free_buffer), (&Free), Constant_Top, NORMAL_GC, 1);
}
- end_transport (NULL);
- fix_weak_chain_1 ();
- /* Load new space into memory. */
+ end_transport (0);
+ fix_weak_chain_1 (Constant_Top);
+ /* Load new space into memory. */
final_reload (block_start, (Free - block_start), "new space");
- fix_weak_chain_2 ();
+ fix_weak_chain_2 ();
GC_end_root_relocation (root, root2);
Constant_Top = saved_ctop;
SET_CONSTANT_TOP ();
- return;
}
\f
/* (GARBAGE-COLLECT SLACK)
return (0);
}
\f
+#ifdef RECORD_GC_STATISTICS
+
static void
DEFUN_VOID (statistics_clear)
{
}
return;
}
+#endif /* RECORD_GC_STATISTICS */
\f
static SCHEME_OBJECT
DEFUN_VOID (statistics_names)
PRIMITIVE_RETURN (vector);
}
\f
+#if CAN_RECONFIGURE_GC_BUFFERS
static long
DEFUN (bchscheme_long_parameter, (vector, index),
SCHEME_OBJECT vector AND int index)
error_bad_range_arg (1);
return (value);
}
+#endif /* CAN_RECONFIGURE_GC_BUFFERS */
DEFINE_PRIMITIVE ("BCHSCHEME-PARAMETERS-SET!", Prim_bchscheme_set_params, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
-#if (CAN_RECONFIGURE_GC_BUFFERS == 0)
+#if !CAN_RECONFIGURE_GC_BUFFERS
signal_error_from_primitive (ERR_UNDEFINED_PRIMITIVE);
/*NOTREACHED*/
return (0);
if (new_drone_ptr != ((char *) NULL))
strcpy (new_drone_ptr, ((char *) (STRING_LOC (new_drone, 0))));
}
-\f
+
if (new_buffer_size != old_buffer_size)
{
int power = (next_exponent_of_two (new_buffer_size));
/* -*-C-*-
-$Id: bchpur.c,v 9.68 2000/11/28 05:19:05 cph Exp $
+$Id: bchpur.c,v 9.69 2000/12/05 21:23:42 cph Exp $
Copyright (c) 1987-2000 Massachusetts Institute of Technology
#include "bchgcc.h"
#include "zones.h"
-/* Purify modes */
-
-#define NORMAL_GC 0
-#define PURE_COPY 1
-#define CONSTANT_COPY 2
-
-/* Some utility macros. */
-
-#define relocate_indirect_setup() \
-{ \
- Old = (OBJECT_ADDRESS (Temp)); \
- if (Old < low_heap) \
- continue; \
- if (BROKEN_HEART_P (* Old)) \
- continue; \
- New_Address = (MAKE_BROKEN_HEART (To_Address)); \
-}
-
-#define relocate_indirect_end() \
-{ \
- (* (OBJECT_ADDRESS (Temp))) = New_Address; \
- continue; \
-}
+static void EXFUN (purify, (SCHEME_OBJECT, Boolean));
+static SCHEME_OBJECT * EXFUN (purify_header_overflow, (SCHEME_OBJECT *));
\f
-/* A modified copy of GCLoop. */
-
-static SCHEME_OBJECT *
-DEFUN (purifyloop, (Scan, To_ptr, To_Address_ptr, purify_mode),
- fast SCHEME_OBJECT * Scan AND
- SCHEME_OBJECT ** To_ptr AND
- SCHEME_OBJECT ** To_Address_ptr AND
- int purify_mode)
-{
- fast SCHEME_OBJECT
- * To, * Old, Temp, * low_heap,
- * To_Address, New_Address;
+/* (PRIMITIVE-PURIFY OBJECT PURE? SAFETY-MARGIN)
- To = (* To_ptr);
- To_Address = (* To_Address_ptr);
- low_heap = Constant_Top;
+ Copy an object from the heap into constant space. It should only
+ be used through the wrapper provided in the Scheme runtime system.
- for ( ; Scan != To; Scan++)
- {
- Temp = (* Scan);
- Switch_by_GC_Type (Temp)
- {
- case TC_BROKEN_HEART:
- if (Scan != scan_buffer_top)
- goto end_purifyloop;
- /* The -1 is here because of the Scan++ in the for header. */
- Scan = ((dump_and_reload_scan_buffer (0, NULL)) - 1);
- continue;
-
- case TC_MANIFEST_NM_VECTOR:
- case TC_MANIFEST_SPECIAL_NM_VECTOR:
- /* Check whether this bumps over current buffer,
- and if so we need a new bufferfull. */
- Scan += (OBJECT_DATUM (Temp));
-area_skipped:
- if (Scan < scan_buffer_top)
- break;
- else
- {
- unsigned long overflow;
-
- /* The + & -1 are here because of the Scan++ in the for header. */
- overflow = ((Scan - scan_buffer_top) + 1);
- Scan = ((dump_and_reload_scan_buffer
- ((overflow >> gc_buffer_shift), NULL)
- + (overflow & gc_buffer_mask)) - 1);
- break;
- }
-\f
- case_compiled_entry_point:
- if (purify_mode == PURE_COPY)
- break;
- relocate_compiled_entry (false);
- (* Scan) = Temp;
- break;
-
- case TC_LINKAGE_SECTION:
- {
- if (purify_mode == PURE_COPY)
- gc_death (TERM_COMPILER_DEATH,
- "purifyloop: linkage section in pure area",
- Scan, To);
- /*NOTREACHED*/
- switch (READ_LINKAGE_KIND (Temp))
- {
- case REFERENCE_LINKAGE_KIND:
- case ASSIGNMENT_LINKAGE_KIND:
- {
- /* count typeless pointers to quads follow. */
-
- fast long count;
- long max_count, max_here;
-
- Scan++;
- max_here = (scan_buffer_top - Scan);
- max_count = (READ_CACHE_LINKAGE_COUNT (Temp));
- while (max_count != 0)
- {
- count = ((max_count > max_here) ? max_here : max_count);
- max_count -= count;
- for ( ; --count >= 0; Scan += 1)
- {
- Temp = *Scan;
- relocate_typeless_pointer (copy_quadruple(), 4);
- }
- if (max_count != 0)
- {
- /* We stopped because we needed to relocate too many. */
- Scan = dump_and_reload_scan_buffer(0, NULL);
- max_here = gc_buffer_size;
- }
- }
- /* The + & -1 are here because of the Scan++ in the for header. */
- Scan -= 1;
- break;
- }
-\f
- case OPERATOR_LINKAGE_KIND:
- case GLOBAL_OPERATOR_LINKAGE_KIND:
- {
- /* Operator linkage */
-
- fast long count;
- fast char *word_ptr, *next_ptr;
- long overflow;
-
- word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
- if (! (word_ptr > ((char *) scan_buffer_top)))
- BCH_START_OPERATOR_RELOCATION (Scan);
- else
- {
- overflow = (word_ptr - ((char *) Scan));
- extend_scan_buffer (word_ptr, To);
- BCH_START_OPERATOR_RELOCATION (Scan);
- word_ptr = (end_scan_buffer_extension (word_ptr));
- Scan = ((SCHEME_OBJECT *) (word_ptr - overflow));
- }
-
- count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
- overflow = ((END_OPERATOR_LINKAGE_AREA (Scan, count)) -
- scan_buffer_top);
-
- for (next_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr));
- (--count >= 0);
- word_ptr = next_ptr,
- next_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr)))
- {
- if (! (next_ptr > ((char *) scan_buffer_top)))
- relocate_linked_operator (false);
- else
- {
- extend_scan_buffer (next_ptr, To);
- relocate_linked_operator (false);
- next_ptr = (end_scan_buffer_extension (next_ptr));
- overflow -= gc_buffer_size;
- }
- }
- Scan = (scan_buffer_top + overflow);
- BCH_END_OPERATOR_RELOCATION (Scan);
- break;
- }
+ To purify an object we just copy it into Pure Space in two
+ parts with the appropriate headers and footers. The actual
+ copying is done by gc_loop.
- case CLOSURE_PATTERN_LINKAGE_KIND:
- Scan += (READ_CACHE_LINKAGE_COUNT (Temp));
- goto area_skipped;
+ Once the copy is complete we run a full GC which handles the
+ broken hearts which now point into pure space.
- default:
- gc_death (TERM_EXIT,
- "purify: Unknown compiler linkage kind.",
- Scan, Free);
- /*NOTREACHED*/
- }
- break;
- }
-\f
- case TC_MANIFEST_CLOSURE:
- {
- if (purify_mode == PURE_COPY)
- gc_death (TERM_COMPILER_DEATH,
- "purifyloop: manifest closure in pure area",
- Scan, To);
- /*NOTREACHED*/
- }
- {
- fast long count;
- fast char * word_ptr;
- char * end_ptr;
+ This primitive does not return normally. It always escapes into
+ the interpreter because some of its cached registers (eg. History)
+ have changed. */
- Scan += 1;
+DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0)
+{
+ Boolean pure_p;
+ SCHEME_OBJECT object, result, daemon;
+ PRIMITIVE_HEADER (3);
+ PRIMITIVE_CANONICALIZE_CONTEXT ();
- /* Is there enough space to read the count? */
+ STACK_SANITY_CHECK ("PURIFY");
+ Save_Time_Zone (Zone_Purify);
+ TOUCH_IN_PRIMITIVE ((ARG_REF (1)), object);
+ CHECK_ARG (2, BOOLEAN_P);
+ pure_p = (BOOLEAN_ARG (2));
+ GC_Reserve = (arg_nonnegative_integer (3));
- end_ptr = (((char *) Scan) + (2 * (sizeof (format_word))));
- if (end_ptr > ((char *) scan_buffer_top))
- {
- long dw;
-
- extend_scan_buffer (end_ptr, To);
- BCH_START_CLOSURE_RELOCATION (Scan - 1);
- count = (MANIFEST_CLOSURE_COUNT (Scan));
- word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
- dw = (word_ptr - end_ptr);
- end_ptr = (end_scan_buffer_extension (end_ptr));
- word_ptr = (end_ptr + dw);
- Scan = ((SCHEME_OBJECT *) (end_ptr - (2 * (sizeof (format_word)))));
- }
- else
- {
- BCH_START_CLOSURE_RELOCATION (Scan - 1);
- count = (MANIFEST_CLOSURE_COUNT (Scan));
- word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
- }
- end_ptr = ((char *) (MANIFEST_CLOSURE_END (Scan, count)));
+ POP_PRIMITIVE_FRAME (3);
- for ( ; ((--count) >= 0);
- (word_ptr = (NEXT_MANIFEST_CLOSURE_ENTRY (word_ptr))))
- {
- if (! ((CLOSURE_ENTRY_END (word_ptr)) > ((char *) scan_buffer_top)))
- relocate_manifest_closure (false);
- else
- {
- char * entry_end;
- long de, dw;
-
- entry_end = (CLOSURE_ENTRY_END (word_ptr));
- de = (end_ptr - entry_end);
- dw = (entry_end - word_ptr);
- extend_scan_buffer (entry_end, To);
- relocate_manifest_closure (false);
- entry_end = (end_scan_buffer_extension (entry_end));
- word_ptr = (entry_end - dw);
- end_ptr = (entry_end + de);
- }
- }
- Scan = ((SCHEME_OBJECT *) (end_ptr));
- BCH_END_CLOSURE_RELOCATION (Scan);
- break;
- }
-\f
- case_Cell:
- if (purify_mode == CONSTANT_COPY)
- break;
- relocate_normal_pointer (copy_cell(), 1);
-
- case TC_REFERENCE_TRAP:
- if ((OBJECT_DATUM (Temp)) <= TRAP_MAX_IMMEDIATE)
- break; /* It is a non pointer. */
- goto purify_pair;
-
- case TC_INTERNED_SYMBOL:
- case TC_UNINTERNED_SYMBOL:
- if (purify_mode == PURE_COPY)
- {
- Temp = (MEMORY_REF (Temp, SYMBOL_NAME));
- relocate_indirect_setup ();
- copy_vector (NULL);
- relocate_indirect_end ();
- }
- else
- goto really_purify_pair;
-
- case_Fasdump_Pair:
- purify_pair:
- if (purify_mode == CONSTANT_COPY)
- break;
- really_purify_pair:
- relocate_normal_pointer (copy_pair(), 2);
-
- case TC_WEAK_CONS:
- if (purify_mode == PURE_COPY)
- break;
- else
- relocate_normal_pointer (copy_weak_pair(), 2);
-
- case TC_VARIABLE:
- case_Triple:
- if (purify_mode == CONSTANT_COPY)
- break;
- relocate_normal_pointer (copy_triple(), 3);
-
- case_Quadruple:
- if (purify_mode == CONSTANT_COPY)
- break;
- relocate_normal_pointer (copy_quadruple(), 4);
-\f
- case TC_COMPILED_CODE_BLOCK:
- if (purify_mode == PURE_COPY)
- break;
- goto aligned_vector_relocation;
-
- case TC_BIG_FLONUM:
- if (purify_mode == CONSTANT_COPY)
- break;
- aligned_vector_relocation:
- relocate_flonum_setup ();
- goto Move_Vector;
-
- case TC_ENVIRONMENT:
- if (purify_mode == PURE_COPY)
- break;
- else
- goto really_purify_vector;
-
- case_Purify_Vector:
- if (purify_mode == CONSTANT_COPY)
- break;
- really_purify_vector:
- relocate_normal_setup ();
- Move_Vector:
- copy_vector (NULL);
- relocate_normal_end ();
-
- case TC_FUTURE:
- if (purify_mode == CONSTANT_COPY)
- break;
- relocate_normal_setup();
- if (!(Future_Spliceable (Temp)))
- goto Move_Vector;
- (* Scan) = (Future_Value (Temp));
- Scan -= 1;
- continue;
-
- default:
- GC_BAD_TYPE ("purifyloop");
- /* Fall Through */
-
- case_Non_Pointer:
- break;
- }
- }
-end_purifyloop:
- (* To_ptr) = To;
- (* To_Address_ptr) = To_Address;
- return (Scan);
-}
+ ENTER_CRITICAL_SECTION ("purify");
+ purify (object, pure_p);
+ result = (MAKE_POINTER_OBJECT (TC_LIST, Free));
+ Free += 2;
+ Free[-2] = SHARP_T;
+ Free[-1] = (LONG_TO_UNSIGNED_FIXNUM (MemTop - Free));
-/* This is not paranoia!
- The two words in the header may overflow the free buffer.
- */
+ Will_Push (CONTINUATION_SIZE);
+ Store_Return (RC_NORMAL_GC_DONE);
+ Store_Expression (result);
+ Save_Cont ();
+ Pushed ();
-static SCHEME_OBJECT *
-DEFUN (purify_header_overflow, (free_buffer), SCHEME_OBJECT * free_buffer)
-{
- long delta;
- SCHEME_OBJECT * scan_buffer;
+ RENAME_CRITICAL_SECTION ("purify daemon");
+ daemon = (Get_Fixed_Obj_Slot (GC_Daemon));
+ if (daemon == SHARP_F)
+ {
+ PRIMITIVE_ABORT (PRIM_POP_RETURN);
+ /*NOTREACHED*/
+ }
- delta = (free_buffer - free_buffer_top);
- free_buffer = (dump_and_reset_free_buffer (delta, NULL));
- scan_buffer = (dump_and_reload_scan_buffer (0, NULL));
- if ((scan_buffer + delta) != free_buffer)
- {
- gc_death (TERM_EXIT,
- "purify: scan and free do not meet at the end",
- (scan_buffer + delta), free_buffer);
- /*NOTREACHED*/
- }
- return (free_buffer);
+ Will_Push (2);
+ STACK_PUSH (daemon);
+ STACK_PUSH (STACK_FRAME_HEADER);
+ Pushed ();
+ PRIMITIVE_ABORT (PRIM_APPLY);
+ /*NOTREACHED*/
+ return (UNSPECIFIC);
}
\f
static void
-DEFUN (purify, (object, purify_mode),
- SCHEME_OBJECT object AND Boolean purify_mode)
+DEFUN (purify, (object, pure_p), SCHEME_OBJECT object AND Boolean pure_p)
{
- long length, pure_length, delta;
- SCHEME_OBJECT
- * result, * free_buffer_ptr,
- * old_free_const, * block_start,
- * scan_start, * new_free_const, * pending_scan,
- * root, * root2, the_precious_objects,
- * saved_const_top;
- struct saved_scan_state scan_state;
- extern Boolean EXFUN (update_allocator_parameters, (SCHEME_OBJECT *));
+ long length;
+ long pure_length;
+ long delta;
+ SCHEME_OBJECT * free_buffer_ptr;
+ SCHEME_OBJECT * old_free_const;
+ SCHEME_OBJECT * block_start;
+ SCHEME_OBJECT * new_free_const;
+ SCHEME_OBJECT * pending_scan;
+ SCHEME_OBJECT * root;
+ SCHEME_OBJECT * root2;
+ SCHEME_OBJECT the_precious_objects;
run_pre_gc_hooks ();
STACK_SANITY_CHECK ("PURIFY");
delta = (old_free_const - block_start);
free_buffer_ptr += delta;
+ (*free_buffer_ptr++) = SHARP_F; /* Pure block header. */
+ (*free_buffer_ptr++) = object;
new_free_const += 2;
- * free_buffer_ptr++ = SHARP_F; /* Pure block header. */
- * free_buffer_ptr++ = object;
if (free_buffer_ptr >= free_buffer_top)
- free_buffer_ptr =
- (dump_and_reset_free_buffer ((free_buffer_ptr - free_buffer_top), NULL));
+ free_buffer_ptr = (dump_and_reset_free_buffer (free_buffer_ptr, 0));
- if (! purify_mode)
- pure_length = 3;
+ if (pure_p)
+ {
+ gc_loop (((initialize_scan_buffer (block_start)) + delta),
+ (&free_buffer_ptr), (&new_free_const), Constant_Top,
+ PURE_COPY, 1);
+ pure_length = ((new_free_const - old_free_const) + 1);
+ }
else
- {
- scan_start = ((initialize_scan_buffer (block_start)) + delta);
- result = (purifyloop (scan_start, &free_buffer_ptr,
- &new_free_const, PURE_COPY));
- if (result != free_buffer_ptr)
- gc_death (TERM_BROKEN_HEART,
- "purify: pure copy ended too early",
- result, free_buffer_ptr);
- /*NOTREACHED*/
- pure_length = ((new_free_const - old_free_const) + 1);
- }
+ pure_length = 3;
- * free_buffer_ptr++ =
- (purify_mode
- ? (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, new_free_const))
- : (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1)));
- * free_buffer_ptr++ = (MAKE_OBJECT (CONSTANT_PART, pure_length));
+ (*free_buffer_ptr++)
+ = (pure_p
+ ? (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, new_free_const))
+ : (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1)));
+ (*free_buffer_ptr++) = (MAKE_OBJECT (CONSTANT_PART, pure_length));
new_free_const += 2;
if (free_buffer_ptr >= free_buffer_top)
free_buffer_ptr = (purify_header_overflow (free_buffer_ptr));
-\f
- scan_start = ((initialize_scan_buffer (block_start)) + delta);
- if (! purify_mode)
- result = (GCLoop (scan_start, &free_buffer_ptr, &new_free_const));
- else
+
{
- SCHEME_OBJECT * pure_area_limit = (new_free_const - 2);
-
- result = (purifyloop (scan_start, &free_buffer_ptr,
- &new_free_const, CONSTANT_COPY));
- if ((* result) != (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, pure_area_limit)))
- gc_death (TERM_BROKEN_HEART,
- "purify: constant forwarding ended too early",
- result, free_buffer_ptr);
- * result = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
- result = (GCLoop ((result + 2), &free_buffer_ptr, &new_free_const));
+ SCHEME_OBJECT * scan_start
+ = ((initialize_scan_buffer (block_start)) + delta);
+ if (pure_p)
+ {
+ SCHEME_OBJECT * pure_area_limit = (new_free_const - 2);
+ SCHEME_OBJECT * result
+ = (gc_loop (scan_start, (&free_buffer_ptr), (&new_free_const),
+ Constant_Top, CONSTANT_COPY, 0));
+ if ((*result)
+ != (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, pure_area_limit)))
+ {
+ gc_death (TERM_BROKEN_HEART, "gc_loop ended too early",
+ result, free_buffer_ptr);
+ /*NOTREACHED*/
+ }
+ (*result) = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
+ scan_start = (result + 2);
+ }
+ pending_scan
+ = (gc_loop (scan_start, (&free_buffer_ptr), (&new_free_const),
+ Constant_Top, NORMAL_GC, 1));
}
if (result != free_buffer_ptr)
result, free_buffer_ptr);
/*NOTREACHED*/
- pending_scan = result;
+ length = (new_free_const + 1 - old_free_const);
+ (*free_buffer_ptr++) = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
+ (*free_buffer_ptr++) = (MAKE_OBJECT (END_OF_BLOCK, length));
new_free_const += 2;
- length = (new_free_const - old_free_const);
- * free_buffer_ptr++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
- * free_buffer_ptr++ = (MAKE_OBJECT (END_OF_BLOCK, (length - 1)));
if (free_buffer_ptr >= free_buffer_top)
- free_buffer_ptr =
- (dump_and_reset_free_buffer ((free_buffer_ptr - free_buffer_top),
- NULL));
+ free_buffer_ptr = (dump_and_reset_free_buffer (free_buffer_ptr, 0));
Free_Constant = new_free_const;
- if (! (update_allocator_parameters (Free_Constant)))
- gc_death (TERM_NO_SPACE, "purify: object too large", NULL, NULL);
- /*NOTREACHED*/
-
- while (! (FLOATING_ALIGNED_P (Free_Constant)))
- {
- *free_buffer_ptr++ = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0));
- Free_Constant++;
- }
-
+ if (!update_allocator_parameters (Free_Constant))
+ {
+ gc_death (TERM_NO_SPACE, "purify: object too large", NULL, NULL);
+ /*NOTREACHED*/
+ }
+ while (!FLOATING_ALIGNED_P (Free_Constant))
+ {
+ (*free_buffer_ptr++) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0));
+ Free_Constant += 1;
+ }
if (Constant_Top > Free_Constant)
- {
- /* This assumes that the distance between the new constant space
- and the new free constant is smaller than a bufferfull.
- */
-
- long bump = (Constant_Top - Free_Constant);
-
- *free_buffer_ptr = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR,
- (bump - 1)));
- free_buffer_ptr += bump;
- if (free_buffer_ptr >= free_buffer_top)
- free_buffer_ptr =
- (dump_and_reset_free_buffer ((free_buffer_ptr - free_buffer_top),
- NULL));
- }
-
- while (! (FLOATING_ALIGNED_P (Free)))
- {
- *free_buffer_ptr++ = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0));
- Free++;
- }
+ {
+ /* This assumes that the distance between the new constant space
+ and the new free constant is smaller than a bufferful. */
+ long bump = (Constant_Top - Free_Constant);
+ (*free_buffer_ptr)
+ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, (bump - 1)));
+ free_buffer_ptr += bump;
+ if (free_buffer_ptr >= free_buffer_top)
+ free_buffer_ptr = (dump_and_reset_free_buffer (free_buffer_ptr, 0));
+ }
+ while (!FLOATING_ALIGNED_P (Free))
+ {
+ (*free_buffer_ptr++) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0));
+ Free += 1;
+ }
root = Free;
Free += (GC_relocate_root (&free_buffer_ptr));
- saved_const_top = Constant_Top;
- Constant_Top = old_free_const;
-
- save_scan_state ((&scan_state), pending_scan);
- set_fixed_scan_area (0, Highest_Allocated_Address);
-
- result = (GCLoop ((CONSTANT_AREA_START ()), &free_buffer_ptr, &Free));
- if (result != old_free_const)
{
- outf_fatal ("\n%s (purify): The Constant Space scan ended too early.\n",
- scheme_program_name);
- Microcode_Termination (TERM_EXIT);
- /*NOTREACHED*/
+ struct saved_scan_state scan_state;
+ save_scan_state ((&scan_state), pending_scan);
+ set_fixed_scan_area (0, Highest_Allocated_Address);
+ {
+ SCHEME_OBJECT * result
+ = (gc_loop ((CONSTANT_AREA_START ()), (&free_buffer_ptr), (&Free),
+ old_free_const, NORMAL_GC, 0));
+ if (result != old_free_const)
+ {
+ gc_death (TERM_EXIT, "gc_loop ended too early",
+ result, free_buffer_ptr);
+ /*NOTREACHED*/
+ }
+ }
+ pending_scan = (restore_scan_state (&scan_state));
}
- pending_scan = (restore_scan_state (&scan_state));
-
- result = (GCLoop (pending_scan, &free_buffer_ptr, &Free));
- if (free_buffer_ptr != result)
- {
- outf_fatal ("\n%s (GC): The Heap scan ended too early.\n",
- scheme_program_name);
- Microcode_Termination (TERM_EXIT);
- /*NOTREACHED*/
- }
+ pending_scan
+ = (gc_loop (pending_scan, (&free_buffer_ptr), (&Free),
+ old_free_const, NORMAL_GC, 1));
root2 = Free;
- *free_buffer_ptr++ = the_precious_objects;
- Free += (free_buffer_ptr - result);
+ (*free_buffer_ptr++) = the_precious_objects;
+ Free += 1;
if (free_buffer_ptr >= free_buffer_top)
- free_buffer_ptr =
- (dump_and_reset_free_buffer ((free_buffer_ptr - free_buffer_top), NULL));
+ free_buffer_ptr = (dump_and_reset_free_buffer (free_buffer_ptr, 0));
- result = (GCLoop (result, &free_buffer_ptr, &Free));
- if (free_buffer_ptr != result)
- {
- outf_fatal ("\n%s (GC): The Precious Object scan ended too early.\n",
- scheme_program_name);
- Microcode_Termination (TERM_EXIT);
- /*NOTREACHED*/
- }
- end_transport (NULL);
- fix_weak_chain_1 ();
+ gc_loop (pending_scan, (&free_buffer_ptr), (&Free),
+ old_free_const, NORMAL_GC, 1);
- /* Load new space into memory carefully to prevent the shared
- buffer from losing any values.
- */
+ end_transport (0);
+ fix_weak_chain_1 (old_free_const);
+ /* Load new space into memory carefully to prevent the shared
+ buffer from losing any values. */
{
- long counter;
+ unsigned long counter;
- for (counter = 0; counter < delta; counter++)
- scan_buffer_bottom[counter] = block_start[counter];
+ for (counter = 0; (counter < delta); counter += 1)
+ (scan_buffer_bottom[counter]) = (block_start[counter]);
final_reload (block_start, (Free - block_start), "new space");
- for (counter = 0; counter < delta; counter++)
- block_start[counter] = scan_buffer_bottom[counter];
+ for (counter = 0; (counter < delta); counter += 1)
+ (block_start[counter]) = (scan_buffer_bottom[counter]);
}
- fix_weak_chain_2 ();
+ fix_weak_chain_2 ();
GC_end_root_relocation (root, root2);
- * old_free_const++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR,
- pure_length));
- * old_free_const = (MAKE_OBJECT (PURE_PART, (length - 1)));
- Constant_Top = saved_const_top;
+ (*old_free_const++)
+ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, pure_length));
+ (*old_free_const) = (MAKE_OBJECT (PURE_PART, length));
SEAL_CONSTANT_SPACE ();
run_post_gc_hooks ();
- return;
}
-\f
-/* (PRIMITIVE-PURIFY OBJECT PURE? SAFETY-MARGIN)
-
- Copy an object from the heap into constant space. It should only
- be used through the wrapper provided in the Scheme runtime system.
-
- To purify an object we just copy it into Pure Space in two
- parts with the appropriate headers and footers. The actual
- copying is done by purifyloop above.
- Once the copy is complete we run a full GC which handles the
- broken hearts which now point into pure space.
-
- This primitive does not return normally. It always escapes into
- the interpreter because some of its cached registers (eg. History)
- have changed.
-*/
-
-DEFINE_PRIMITIVE ("PRIMITIVE-PURIFY", Prim_primitive_purify, 3, 3, 0)
+/* This is not paranoia!
+ The two words in the header may overflow the free buffer. */
+static SCHEME_OBJECT *
+DEFUN (purify_header_overflow, (free_buffer), SCHEME_OBJECT * free_buffer)
{
- Boolean purify_mode;
- SCHEME_OBJECT object, result, daemon;
- PRIMITIVE_HEADER (3);
- PRIMITIVE_CANONICALIZE_CONTEXT ();
-
- STACK_SANITY_CHECK ("PURIFY");
- Save_Time_Zone (Zone_Purify);
- TOUCH_IN_PRIMITIVE ((ARG_REF (1)), object);
- CHECK_ARG (2, BOOLEAN_P);
- purify_mode = (BOOLEAN_ARG (2));
- GC_Reserve = (arg_nonnegative_integer (3));
-
- POP_PRIMITIVE_FRAME (3);
-
- ENTER_CRITICAL_SECTION ("purify");
- purify (object, purify_mode);
- result = (MAKE_POINTER_OBJECT (TC_LIST, Free));
- Free += 2;
- Free[-2] = SHARP_T;
- Free[-1] = (LONG_TO_UNSIGNED_FIXNUM (MemTop - Free));
-
- Will_Push (CONTINUATION_SIZE);
- Store_Return (RC_NORMAL_GC_DONE);
- Store_Expression (result);
- Save_Cont ();
- Pushed ();
-
- RENAME_CRITICAL_SECTION ("purify daemon");
- daemon = (Get_Fixed_Obj_Slot (GC_Daemon));
- if (daemon == SHARP_F)
- PRIMITIVE_ABORT (PRIM_POP_RETURN);
- /*NOTREACHED*/
-
- Will_Push (2);
- STACK_PUSH (daemon);
- STACK_PUSH (STACK_FRAME_HEADER);
- Pushed ();
- PRIMITIVE_ABORT (PRIM_APPLY);
- /*NOTREACHED*/
- return (0);
+ long delta = (free_buffer - free_buffer_top);
+ free_buffer = (dump_and_reset_free_buffer (free_buffer, 0));
+ {
+ SCHEME_OBJECT * scan_buffer
+ = (dump_and_reload_scan_buffer (scan_buffer_top, 0));
+ if ((scan_buffer + delta) != free_buffer)
+ {
+ gc_death (TERM_EXIT,
+ "purify: scan and free do not meet at the end",
+ (scan_buffer + delta), free_buffer);
+ /*NOTREACHED*/
+ }
+ }
+ return (free_buffer);
}
/* -*-C-*-
-$Id: bchutl.c,v 1.10 2000/01/18 05:06:42 cph Exp $
+$Id: bchutl.c,v 1.11 2000/12/05 21:23:43 cph Exp $
Copyright (c) 1991-2000 Massachusetts Institute of Technology
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
-#include "oscond.h"
-#include "ansidecl.h"
+#include "config.h"
#include <stdio.h>
#include <errno.h>
#ifndef EINTR
-#define EINTR 1999
+# define EINTR 1999
#endif
-#ifndef DOS386
-#ifndef WINNT
-#ifndef _OS2
-#ifndef _NEXTOS
-#include <unistd.h>
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
#endif
-#endif
-#endif
-#endif
-
-extern char * EXFUN (error_name, (int));
-extern int EXFUN (retrying_file_operation,
- (int (*)(int, char *, unsigned int),
- int, char *, long, long, char *, char *, long *,
- int (*)(char *, char *)));
\f
-#ifdef WINNT
+#ifdef __WIN32__
#define lseek _lseek
return (&buf[0]);
}
-#else /* not WINNT */
-#ifdef _OS2
+#else /* not __WIN32__ */
+#ifdef __OS2__
#if defined(__IBMC__) || defined(__WATCOMC__) || defined(__EMX__)
#include <io.h>
return (&buf[0]);
}
-#else /* not _OS2 */
+#else /* not __OS2__ */
char *
DEFUN (error_name, (code), int code)
return (&buf[0]);
}
-#endif /* not _OS2 */
-#endif /* not WINNT */
+#endif /* not __OS2__ */
+#endif /* not __WIN32__ */
#ifndef SEEK_SET
#define SEEK_SET 0
/* -*-C-*-
-$Id: bignum.c,v 9.48 2000/01/18 05:07:03 cph Exp $
+$Id: bignum.c,v 9.49 2000/12/05 21:23:43 cph Exp $
Copyright (c) 1989-2000 Massachusetts Institute of Technology
DEFUN (bignum_subtract_unsigned, (x, y),
bignum_type x AND bignum_type y)
{
- int negative_p;
+ int negative_p = 0;
switch (bignum_compare_unsigned (x, y))
{
case bignum_comparison_equal:
bignum_digit_type * u_scan_start = (u_scan - v_length);
bignum_digit_type * v_start = (BIGNUM_START_PTR (v));
bignum_digit_type * v_end = (v_start + v_length);
- bignum_digit_type * q_scan;
+ bignum_digit_type * q_scan = 0;
bignum_digit_type v1 = (v_end[-1]);
bignum_digit_type v2 = (v_end[-2]);
fast bignum_digit_type ph; /* high half of double-digit product */
/* -*-C-*-
-$Id: bintopsb.c,v 9.71 2000/01/18 05:07:46 cph Exp $
+$Id: bintopsb.c,v 9.72 2000/12/05 21:23:43 cph Exp $
Copyright (c) 1987-2000 Massachusetts Institute of Technology
/* Character macros and procedures */
-#ifndef _IRIX
+#ifndef __IRIX__
extern int strlen ();
#endif
/* -*-C-*-
-$Id: bitstr.c,v 9.62 2000/01/18 05:08:00 cph Exp $
+$Id: bitstr.c,v 9.63 2000/12/05 21:23:43 cph Exp $
Copyright (c) 1987-2000 Massachusetts Institute of Technology
#include "scheme.h"
#include "prims.h"
#include "bitstr.h"
-\f
-extern SCHEME_OBJECT EXFUN (allocate_bit_string, (long));
-SCHEME_OBJECT
+static void EXFUN
+ (copy_bits, (SCHEME_OBJECT *, long, SCHEME_OBJECT *, long, long));
+\f
+static SCHEME_OBJECT
DEFUN (allocate_bit_string, (length), long length)
{
long total_pointers;
fast SCHEME_OBJECT bit_string_1, bit_string_2;
long start1, end1, start2, end2, nbits;
long end1_mod, end2_mod;
- void copy_bits();
PRIMITIVE_HEADER (5);
CHECK_ARG (1, BIT_STRING_P);
bit_string_1 = (ARG_REF (1));
each of the arguments SOURCE and DESTINATION. It copies the bits
starting with the MSB of a bit string and moving down. */
-void
+static void
DEFUN (copy_bits,
(source, source_offset, destination, destination_offset, nbits),
SCHEME_OBJECT * source AND
/* -*-C-*-
-$Id: bitstr.h,v 1.9 1999/01/02 06:11:34 cph Exp $
+$Id: bitstr.h,v 1.10 2000/12/05 21:23:43 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
\f
/* Byte order dependencies. */
-#ifdef VAX_BYTE_ORDER
+#ifndef WORDS_BIGENDIAN
/*
offset = (OBJECT_LENGTH - offset); \
}
\f
-#else /* not VAX_BYTE_ORDER */
+#else /* WORDS_BIGENDIAN */
/*
#define COMPUTE_READ_BITS_OFFSET(offset, end) \
(offset) = ((offset) % OBJECT_LENGTH);
-#endif /* VAX_BYTE_ORDER */
+#endif /* WORDS_BIGENDIAN */
/* -*-C-*-
-$Id: boot.c,v 9.103 2000/01/18 04:26:30 cph Exp $
+$Id: boot.c,v 9.104 2000/12/05 21:23:43 cph Exp $
Copyright (c) 1988-2000 Massachusetts Institute of Technology
scheme_program_name = (argv[0]);
initial_C_stack_pointer = ((PTR) (&argc));
-#ifdef WINNT
+#ifdef __WIN32__
{
extern void NT_initialize_win32_system_utilities();
NT_initialize_win32_system_utilities ();
#ifdef PREALLOCATE_HEAP_MEMORY
PREALLOCATE_HEAP_MEMORY ();
#endif
-#ifdef _OS2
+#ifdef __OS2__
{
extern void OS2_initialize_early (void);
OS2_initialize_early ();
if (!option_band_specified)
{
outf_console ("Scheme Microcode Version %d.%d\n",
- VERSION, SUBVERSION);
+ SCHEME_VERSION, SCHEME_SUBVERSION);
OS_initialize ();
Enter_Interpreter ();
}
ARITY_DISPATCHER_TAG,
char_pointer_to_symbol("#[(microcode)arity-dispatcher-tag]"));
-#ifdef DOS386
- {
- extern void EXFUN (DOS_initialize_fov, (SCHEME_OBJECT));
-
- DOS_initialize_fov (fixed_objects_vector);
- }
-#endif /* DOS386 */
-
-#ifdef WINNT
+#ifdef __WIN32__
{
extern void EXFUN (NT_initialize_fov, (SCHEME_OBJECT));
-
NT_initialize_fov (fixed_objects_vector);
}
-#endif /* WINNT */
+#endif
}
\f
/* Boot Scheme */
DEFUN (Start_Scheme, (Start_Prim, File_Name),
int Start_Prim AND CONST char * File_Name)
{
- SCHEME_OBJECT FName, expr, * inner_arg, prim;
+ SCHEME_OBJECT FName;
+ SCHEME_OBJECT expr = SHARP_F;
+ SCHEME_OBJECT * inner_arg;
+ SCHEME_OBJECT prim;
/* fast long i; */
/* Parallel processor test */
Boolean I_Am_Master = (Start_Prim != BOOT_GET_WORK);
OS_initialize ();
if (I_Am_Master)
{
- outf_console ("Scheme Microcode Version %d.%d\n", VERSION, SUBVERSION);
+ outf_console ("Scheme Microcode Version %d.%d\n",
+ SCHEME_VERSION, SCHEME_SUBVERSION);
outf_console ("MIT Scheme running under %s\n", OS_Variant);
OS_announcement ();
outf_flush_console ();
Enter_Interpreter ();
}
\f
-#ifdef WINNT
-
-extern void EXFUN (WinntEnterHook, (void (*) (void)));
-#define HOOK_ENTER_INTERPRETER WinntEnterHook
-
-#else /* not WINNT */
-#ifdef _OS2
-
-extern void EXFUN (OS2_enter_interpreter, (void (*) (void)));
-#define HOOK_ENTER_INTERPRETER OS2_enter_interpreter
-
-#else /* not _OS2 */
-
-#define HOOK_ENTER_INTERPRETER(func) func ()
-
-#endif /* not _OS2 */
-#endif /* not WINNT */
+#ifdef __WIN32__
+ extern void EXFUN (win32_enter_interpreter, (void (*) (void)));
+# define HOOK_ENTER_INTERPRETER win32_enter_interpreter
+#else
+# ifdef __OS2__
+ extern void EXFUN (OS2_enter_interpreter, (void (*) (void)));
+# define HOOK_ENTER_INTERPRETER OS2_enter_interpreter
+# else
+# define HOOK_ENTER_INTERPRETER(func) func ()
+# endif
+#endif
static void
DEFUN_VOID (Do_Enter_Interpreter)
fast SCHEME_OBJECT Result;
PRIMITIVE_HEADER (0);
Result = (make_vector (IDENTITY_LENGTH, SHARP_F, true));
- FAST_VECTOR_SET (Result, ID_RELEASE,
- (char_pointer_to_string ((unsigned char *) RELEASE)));
FAST_VECTOR_SET
- (Result, ID_MICRO_VERSION, (LONG_TO_UNSIGNED_FIXNUM (VERSION)));
+ (Result, ID_RELEASE,
+ (char_pointer_to_string ((unsigned char *) SCHEME_RELEASE)));
+ FAST_VECTOR_SET
+ (Result, ID_MICRO_VERSION, (LONG_TO_UNSIGNED_FIXNUM (SCHEME_VERSION)));
FAST_VECTOR_SET
- (Result, ID_MICRO_MOD, (LONG_TO_UNSIGNED_FIXNUM (SUBVERSION)));
+ (Result, ID_MICRO_MOD, (LONG_TO_UNSIGNED_FIXNUM (SCHEME_SUBVERSION)));
FAST_VECTOR_SET
(Result, ID_PRINTER_WIDTH, (LONG_TO_UNSIGNED_FIXNUM (OS_tty_x_size ())));
FAST_VECTOR_SET
changecom(`;');;; -*-Midas-*-
;;;
-;;; $Id: hppa.m4,v 1.38 1999/01/02 06:06:43 cph Exp $
+;;; $Id: hppa.m4,v 1.39 2000/12/05 21:23:50 cph Exp $
;;;
-;;; Copyright (c) 1989-1999 Massachusetts Institute of Technology
+;;; Copyright (c) 1989-2000 Massachusetts Institute of Technology
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
changequote(",")
define(HEX, "0x$1")
define(ASM_DEBUG, 0)
-define(TC_LENGTH, ifdef("TYPE_CODE_LENGTH", TYPE_CODE_LENGTH, 8))
+define(TC_LENGTH, ifdef("TYPE_CODE_LENGTH", TYPE_CODE_LENGTH, 6))
define(QUAD_MASK, eval(2 ** (TC_LENGTH - 2)))
define(LOW_TC_BIT, eval(TC_LENGTH - 1))
define(DATUM_LENGTH, eval(32 - TC_LENGTH))
--- /dev/null
+#!/bin/sh
+
+# $Id: m4-dos,v 1.2 2000/12/05 21:23:50 cph Exp $
+#
+# Copyright (c) 2000 Massachusetts Institute of Technology
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or (at
+# your option) any later version.
+#
+# 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, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Processing to get DOS (or Win32 or OS/2) assembly language from "i386.m4".
+
+TEMP_FILE="m4.tmp"
+SEEN_INPUT=0
+rm -f "${TEMP_FILE}"
+echo "changecom(\`;')" >> "${TEMP_FILE}"
+while [ $# -ne 0 ]; do
+ if [ "${1}" = "-P" ]; then
+ echo "define(${2})" >> "${TEMP_FILE}"
+ shift
+ else
+ SEEN_INPUT=1
+ sed -e '/#/;/g' < "${1}" >> "${TEMP_FILE}"
+ fi
+ shift
+done
+if [ ${SEEN_INPUT} -eq 0 ]; then
+ sed -e 's/#/;/g' >> "${TEMP_FILE}"
+fi
+m4 < "${TEMP_FILE}" | sed -e 's/^\f$//' | sed -n -e '/^..*/p'
+rm -f "${TEMP_FILE}"
+# $Id: makefile,v 1.7 2000/12/05 21:23:50 cph Exp $
#
-# Makefile for i386 PC compiled code interface files
-# for the MIT Scheme microcode.
+# Copyright (c) 2000 Massachusetts Institute of Technology
#
-# $Id: makefile,v 1.6 1995/10/24 06:32:35 cph Exp $
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or (at
+# your option) any later version.
#
+# 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, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-all : i386-dos.asm i386-nt.asm i386-ntw.asm
+# Makefile for MIT Scheme's i386 compiled-code interface files.
-# Expand for DOS.
-i386-dos.asm : i386.m4 ../s/dos.m4
- rm -f $@
- ../s/dos.m4 < $< > $@
+EXPANSIONS = i386-nt.asm i386-ntw.asm
+
+all: $(EXPANSIONS)
# Expand for Win32 using Microsoft compiler.
-i386-nt.asm : i386.m4 ../s/nt.m4
+i386-nt.asm: i386.m4
rm -f $@
- ../s/nt.m4 < $< > $@
+ ./m4-dos -P "WIN32,1" < i386.m4 > i386-nt.asm
# Expand for Win32 using Watcom compiler.
-i386-ntw.asm : i386.m4 ../s/nt.m4
+i386-ntw.asm: i386.m4
rm -f $@
- ../s/nt.m4 -P "define(WCC386R,1)" < $< > $@
+ ./m4-dos -P "WIN32,1" -P "WCC386R,1" < i386.m4 > i386-ntw.asm
+
+maintainer-clean:
+ rm -f $(EXPANSIONS)
+
+.PHONY: all maintainer-clean
### -*-Midas-*-
###
-### $Id: mc68k.m4,v 1.26 1999/01/02 06:11:34 cph Exp $
+### $Id: mc68k.m4,v 1.27 2000/12/05 21:23:50 cph Exp $
###
-### Copyright (c) 1989-1999 Massachusetts Institute of Technology
+### Copyright (c) 1989-2000 Massachusetts Institute of Technology
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License as
# Scheme object representation. Must match object.h
define(HEX, `0x$1')
-define(TC_LENGTH, ifdef(`TYPE_CODE_LENGTH', TYPE_CODE_LENGTH, 8))
+define(TC_LENGTH, ifdef(`TYPE_CODE_LENGTH', TYPE_CODE_LENGTH, 6))
define(ADDRESS_MASK, eval(((2 ** (32 - TC_LENGTH)) - 1), 16))
define(TYPE_CODE_FACTOR, eval(2 ** (8 - TC_LENGTH)))
define(TYPE_CODE_MASK, eval((256 - TYPE_CODE_FACTOR), 16))
### -*-Midas-*-
###
-### $Id: vax.m4,v 1.3 1999/01/02 06:11:34 cph Exp $
+### $Id: vax.m4,v 1.4 2000/12/05 21:23:50 cph Exp $
###
-### Copyright (c) 1991-1999 Massachusetts Institute of Technology
+### Copyright (c) 1991-2000 Massachusetts Institute of Technology
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License as
\f
# This must match the compiler (machines/vax/machin.scm)
-define(TC_LENGTH, ifdef(`TYPE_CODE_LENGTH', TYPE_CODE_LENGTH, 8))
+define(TC_LENGTH, ifdef(`TYPE_CODE_LENGTH', TYPE_CODE_LENGTH, 6))
define(ADDRESS_MASK, eval((0 - (2 ** (32 - TC_LENGTH))), 10))
define(rval,r9)
/* -*-C-*-
-$Id: cmpgc.h,v 1.30 1999/01/02 06:11:34 cph Exp $
+$Id: cmpgc.h,v 1.31 2000/12/05 21:23:43 cph Exp $
-Copyright (c) 1989-1999 Massachusetts Institute of Technology
+Copyright (c) 1989-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#define RELOCATE_COMPILED_RAW_ADDRESS(addr, new_block, old_block) \
(ADDR_TO_SCHEME_ADDR \
- (RELOCATE_COMPILED_INTERNAL ((SCHEME_ADDR_TO_ADDR (Temp)), \
+ (RELOCATE_COMPILED_INTERNAL ((SCHEME_ADDR_TO_ADDR (addr)), \
new_block, old_block)))
#define RELOCATE_COMPILED_ADDRESS(object, new_block, old_block) \
#ifndef FLUSH_I_CACHE
# define FLUSH_I_CACHE() do {} while (0)
-#endif /* FLUSH_I_CACHE */
+#endif
+
+#if !defined(PUSH_D_CACHE_REGION) && defined(FLUSH_I_CACHE_REGION)
+# define PUSH_D_CACHE_REGION(addr, nwords) FLUSH_I_CACHE_REGION(addr, nwords)
+#endif
#ifndef COMPILER_TRANSPORT_END
# define COMPILER_TRANSPORT_END() do \
/* -*-C-*-
-$Id: cmpint.c,v 1.91 1999/01/02 06:06:43 cph Exp $
+$Id: cmpint.c,v 1.92 2000/12/05 21:23:43 cph Exp $
-Copyright (c) 1989-1999 Massachusetts Institute of Technology
+Copyright (c) 1989-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
/* Macro imports */
+#include "config.h"
#include <stdio.h>
-#ifndef _NEXTOS
-#include <stdlib.h>
+#ifdef STDC_HEADERS
+# include <stdlib.h>
#endif
-#include "oscond.h" /* Identify the operating system */
-#include "ansidecl.h" /* Macros to support ANSI declarations */
#include "dstack.h" /* Dynamic-stack support */
-#include "config.h" /* SCHEME_OBJECT type and machine dependencies */
#include "outf.h" /* error reporting */
#include "types.h" /* Needed by const.h */
#include "const.h" /* REGBLOCK_MINIMUM_LENGTH and PRIM_... codes */
#ifdef HAS_COMPILER_SUPPORT
\f
-#ifndef FLUSH_I_CACHE_REGION
-# define FLUSH_I_CACHE_REGION(addr, nwords) NOP()
-#endif
-
-#ifndef PUSH_D_CACHE_REGION
-# define PUSH_D_CACHE_REGION(addr, nwords) FLUSH_I_CACHE_REGION(addr, nwords)
-#endif
-
/* ASM_ENTRY_POINT, EXFNX, and DEFNX are for OS/2. The IBM C Set++/2
compiler has several different external calling conventions. The
default calling convention is called _Optlink, uses a combination
C_to_interface, interface_to_C, and interface_to_scheme. */
#ifndef ASM_ENTRY_POINT
-#define ASM_ENTRY_POINT(name) name
+# define ASM_ENTRY_POINT(name) name
#endif
-#if defined(__STDC__) || defined(__IBMC__) || defined(CL386)
+#ifdef STDC_HEADERS
#define EXFNX(name, proto) ASM_ENTRY_POINT (name) proto
#define DEFNX(name, arglist, args) ASM_ENTRY_POINT (name) (args)
#define DEFNX_VOID(name) ASM_ENTRY_POINT (name) (void)
EXFUN (compiled_block_debugging_info, (SCHEME_OBJECT block)),
EXFUN (compiled_block_environment, (SCHEME_OBJECT block)),
EXFUN (compiled_closure_to_entry, (SCHEME_OBJECT entry)),
- * EXFUN (compiled_entry_to_block_address, (SCHEME_OBJECT entry)),
EXFUN (compiled_entry_to_block, (SCHEME_OBJECT entry)),
EXFUN (apply_compiled_from_primitive, (int)),
EXFUN (compiled_with_interrupt_mask, (unsigned long,
EXFUN (compiler_reset, (SCHEME_OBJECT new_block)),
EXFUN (store_variable_cache,
(SCHEME_OBJECT extension, SCHEME_OBJECT block, long offset)),
- EXFUN (compiled_entry_type, (SCHEME_OBJECT entry, long *buffer)),
EXFUN (declare_compiled_code_block, (SCHEME_OBJECT block));
-extern C_TO_SCHEME long
- EXFUN (enter_compiled_expression, (void)),
- EXFUN (apply_compiled_procedure, (void)),
- EXFUN (return_to_compiled_code, (void)),
- EXFUN (comp_link_caches_restart, (void)),
- EXFUN (comp_op_lookup_trap_restart, (void)),
- EXFUN (comp_interrupt_restart, (void)),
- EXFUN (comp_assignment_trap_restart, (void)),
- EXFUN (comp_cache_lookup_apply_restart, (void)),
- EXFUN (comp_lookup_trap_restart, (void)),
- EXFUN (comp_safe_lookup_trap_restart, (void)),
- EXFUN (comp_unassigned_p_trap_restart, (void)),
- EXFUN (comp_access_restart, (void)),
- EXFUN (comp_reference_restart, (void)),
- EXFUN (comp_safe_reference_restart, (void)),
- EXFUN (comp_unassigned_p_restart, (void)),
- EXFUN (comp_unbound_p_restart, (void)),
- EXFUN (comp_assignment_restart, (void)),
- EXFUN (comp_definition_restart, (void)),
- EXFUN (comp_lookup_apply_restart, (void)),
- EXFUN (comp_error_restart, (void));
-
extern utility_table_entry utility_table[];
static SCHEME_OBJECT reflect_to_interface;
RETURN_TO_C (PRIM_DONE);
}
\f
-#if (COMPILER_PROCESSOR_TYPE != COMPILER_I386_TYPE)
+#if (COMPILER_PROCESSOR_TYPE != COMPILER_IA32_TYPE)
#define INVOKE_RETURN_ADDRESS() \
RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ()))
-#else /* i386 */
+#else /* COMPILER_IA32_TYPE */
static utility_result
EXFUN (compiler_interrupt_common, (SCHEME_ADDR, SCHEME_OBJECT));
RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
} while (0)
-#endif /* i386 */
+#endif /* COMPILER_IA32_TYPE */
/*
comutil_primitive_apply is used to invoked a C primitive.
long original_count AND
instruction * ret_add)
{
- Boolean execute_p;
+ Boolean execute_p = false;
register long entry_size, count;
SCHEME_OBJECT block;
SCHEME_OBJECT header;
exit_proc:
/* Rather than commit, since we want to undo */
transaction_abort ();
+#if defined(FLUSH_I_CACHE_REGION) || defined(PUSH_D_CACHE_REGION)
{
SCHEME_OBJECT * ret_add_block;
unsigned long block_len = (((unsigned long) (* block_address)) + 1);
Get_Compiled_Block (ret_add_block, ((SCHEME_OBJECT *) ret_add));
if (ret_add_block == block_address)
- FLUSH_I_CACHE_REGION (block_address, block_len);
+ {
+#ifdef FLUSH_I_CACHE_REGION
+ FLUSH_I_CACHE_REGION (block_address, block_len);
+#endif
+ }
else
- PUSH_D_CACHE_REGION (block_address, block_len);
+ {
+#ifdef PUSH_D_CACHE_REGION
+ PUSH_D_CACHE_REGION (block_address, block_len);
+#endif
+ }
}
+#endif
return (result);
}
\f
instruction * ret_add;
original_count = (OBJECT_DATUM (STACK_POP()));
- STACK_POP (); /* Loop count, for debugger */
+ (void) STACK_POP (); /* Loop count, for debugger */
block = (STACK_POP ());
environment = (compiled_block_environment (block));
Store_Env (environment);
{
instruction * ret_add;
- STACK_POP (); /* primitive */
+ (void) STACK_POP (); /* primitive */
ret_add = ((instruction *) (OBJECT_ADDRESS (STACK_POP ())));
ENTER_SCHEME (ret_add);
}
buffer[0] = kind;
buffer[1] = field1;
buffer[2] = field2;
- return;
}
void
DEFUN (declare_compiled_code_block, (block), SCHEME_OBJECT block)
{
+#ifdef PUSH_D_CACHE_REGION
SCHEME_OBJECT * block_addr = (OBJECT_ADDRESS (block));
-
PUSH_D_CACHE_REGION (block_addr, (1+ (OBJECT_DATUM (* block_addr))));
- return;
+#endif
}
\f
/* Destructuring free variable caches. */
FAST_MEMORY_SET (block, offset,
((SCHEME_OBJECT)
(ADDR_TO_SCHEME_ADDR (OBJECT_ADDRESS (extension)))));
- return;
}
C_UTILITY SCHEME_OBJECT
STORE_EXECUTE_CACHE_CODE (cache_address);
STORE_EXECUTE_CACHE_ADDRESS (cache_address,
(ADDR_TO_SCHEME_ADDR (entry_address)));
+#ifdef FLUSH_I_CACHE_REGION
if (!linking_cc_block_p)
- {
- /* The linker will flush the whole region afterwards. */
-
- FLUSH_I_CACHE_REGION (cache_address, EXECUTE_CACHE_ENTRY_SIZE);
- }
- return;
+ {
+ /* The linker will flush the whole region afterwards. */
+ FLUSH_I_CACHE_REGION (cache_address, EXECUTE_CACHE_ENTRY_SIZE);
+ }
+#endif
}
\f
/* This makes a fake compiled procedure which traps to kind handler when
case REFLECT_CODE_STACK_MARKER:
{
- STACK_POP (); /* marker1 */
- STACK_POP (); /* marker2 */
+ (void) STACK_POP (); /* marker1 */
+ (void) STACK_POP (); /* marker2 */
INVOKE_RETURN_ADDRESS ();
}
char * name;
};
-#ifdef __STDC__
+#ifdef STDC_HEADERS
# define UTLD(name) { ((PTR) name), #name }
#else
/* Hope that this works. */
compiler_utilities,
return_to_interpreter;
-#if !defined(REGBLOCK_ALLOCATED_BY_INTERFACE) && !defined(WINNT)
+#if !defined(REGBLOCK_ALLOCATED_BY_INTERFACE) && !defined(__WIN32__)
SCHEME_OBJECT
Registers[REGBLOCK_LENGTH];
#endif
the register before `setjmp' is called. */
interface_initialize ();
#endif
-#ifdef _OS2
+#ifdef __OS2__
/* Same as for Sony. */
i386_interface_initialize ();
#endif
extern void EXFUN (bkpt_remove, (PTR, SCHEME_OBJECT));
\f
SCHEME_OBJECT
-#ifndef WINNT
+#ifndef __WIN32__
Registers[REGBLOCK_MINIMUM_LENGTH],
#endif
compiler_utilities,
#endif /* HAS_COMPILER_SUPPORT */
\f
-#ifdef WINNT
+#ifdef __WIN32__
#include "ntscmlib.h"
-extern unsigned long * winnt_catatonia_block;
-extern void EXFUN (winnt_allocate_registers, (void));
-extern void EXFUN (winnt_allocate_registers, (void));
+extern unsigned long * win32_catatonia_block;
+extern void EXFUN (win32_allocate_registers, (void));
+extern void EXFUN (win32_allocate_registers, (void));
#ifndef REGBLOCK_LENGTH
# define REGBLOCK_LENGTH REGBLOCK_MINIMUM_LENGTH
{
/* The following must be allocated consecutively */
unsigned long catatonia_block[3];
-#if (COMPILER_PROCESSOR_TYPE == COMPILER_I386_TYPE)
+#if (COMPILER_PROCESSOR_TYPE == COMPILER_IA32_TYPE)
void * Regstart[32]; /* Negative byte offsets from &Registers[0] */
#endif
SCHEME_OBJECT Registers [REGBLOCK_LENGTH];
} REGMEM;
SCHEME_OBJECT * RegistersPtr = ((SCHEME_OBJECT *) NULL);
-unsigned long * winnt_catatonia_block = ((unsigned long *) NULL);
+unsigned long * win32_catatonia_block = ((unsigned long *) NULL);
static REGMEM regmem;
void
-DEFUN_VOID (winnt_allocate_registers)
+DEFUN_VOID (win32_allocate_registers)
{
REGMEM * mem = & regmem;
- winnt_catatonia_block = ((unsigned long *) &mem->catatonia_block[0]);
+ win32_catatonia_block = ((unsigned long *) &mem->catatonia_block[0]);
RegistersPtr = mem->Registers;
if (! (win32_system_utilities.lock_memory_area (mem, (sizeof (REGMEM)))))
{
}
void
-DEFUN_VOID (winnt_deallocate_registers)
+DEFUN_VOID (win32_deallocate_registers)
{
win32_system_utilities.unlock_memory_area (®mem, (sizeof (REGMEM)));
return;
}
-#endif /* WINNT */
+#endif /* __WIN32__ */
/* -*-C-*-
-$Id: cmpint.h,v 10.6 1999/01/02 06:11:34 cph Exp $
+$Id: cmpint.h,v 10.7 2000/12/05 21:23:43 cph Exp $
-Copyright (c) 1987, 1988, 1989, 1990, 1999 Massachusetts Institute of Technology
+Copyright (c) 1987-1990, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
/* Save_Cont (); */ \
Compiler_New_Subproblem (); \
}
+
+extern long EXFUN (apply_compiled_procedure, (void));
+extern long EXFUN (comp_access_restart, (void));
+extern long EXFUN (comp_assignment_restart, (void));
+extern long EXFUN (comp_assignment_trap_restart, (void));
+extern long EXFUN (comp_cache_lookup_apply_restart, (void));
+extern long EXFUN (comp_definition_restart, (void));
+extern long EXFUN (comp_error_restart, (void));
+extern long EXFUN (comp_interrupt_restart, (void));
+extern long EXFUN (comp_link_caches_restart, (void));
+extern long EXFUN (comp_lookup_apply_restart, (void));
+extern long EXFUN (comp_lookup_trap_restart, (void));
+extern long EXFUN (comp_op_lookup_trap_restart, (void));
+extern long EXFUN (comp_reference_restart, (void));
+extern long EXFUN (comp_safe_lookup_trap_restart, (void));
+extern long EXFUN (comp_safe_reference_restart, (void));
+extern long EXFUN (comp_unassigned_p_restart, (void));
+extern long EXFUN (comp_unassigned_p_trap_restart, (void));
+extern long EXFUN (comp_unbound_p_restart, (void));
+extern long EXFUN (enter_compiled_expression, (void));
+extern long EXFUN (return_to_compiled_code, (void));
+
+extern SCHEME_OBJECT * EXFUN
+ (compiled_entry_to_block_address, (SCHEME_OBJECT));
+
+extern void EXFUN (compiled_entry_type, (SCHEME_OBJECT, long *));
/* -*-C-*-
-$Id: i386.h,v 1.31 1999/01/02 06:11:34 cph Exp $
+$Id: i386.h,v 1.32 2000/12/05 21:23:50 cph Exp $
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
* Specialized for the Intel 386 (and successors) architecture.
*/
-#ifndef CMPINTMD_H_INCLUDED
-#define CMPINTMD_H_INCLUDED
+#ifndef SCM_CMPINTMD_H
+#define SCM_CMPINTMD_H
#include "cmptype.h"
\f
/* Hack for OS/2 calling-convention type: */
-#if defined(_OS2) && (defined(__IBMC__) || defined(__WATCOMC__))
-#define ASM_ENTRY_POINT(name) (_System name)
+#if defined(__OS2__) && (defined(__IBMC__) || defined(__WATCOMC__))
+# define ASM_ENTRY_POINT(name) (_System name)
#else
-#if defined(WINNT) && defined(__WATCOMC__)
-#define ASM_ENTRY_POINT(name) (__cdecl name)
-#else
-#define ASM_ENTRY_POINT(name) name
-#endif
+# if defined(__WIN32__) && defined(__WATCOMC__)
+# define ASM_ENTRY_POINT(name) (__cdecl name)
+# else
+# define ASM_ENTRY_POINT(name) name
+# endif
#endif
/*
*/
\f
-#define COMPILER_PROCESSOR_TYPE COMPILER_I386_TYPE
+#define COMPILER_PROCESSOR_TYPE COMPILER_IA32_TYPE
/* The i387 coprocessor and i486 use 80-bit extended format internally. */
#ifdef _MACH_UNIX
# include <mach.h>
# define VM_PROT_SCHEME (VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE)
-#endif /* _MACH_UNIX */
+#endif
long i386_pc_displacement_relocation = 0;
#define ASM_RESET_HOOK i386_reset_hook
#ifndef HOOK_TO_SCHEME_OFFSET
-#define HOOK_TO_SCHEME_OFFSET(hook) ((unsigned long) (hook))
+# define HOOK_TO_SCHEME_OFFSET(hook) ((unsigned long) (hook))
#endif
-#ifdef __STDC__
-#define STRINGIFY(x) #x
+#ifdef HAVE_STDC
+# define STRINGIFY(x) #x
#else
-#define STRINGIFY(x) "x"
+# define STRINGIFY(x) "x"
#endif
#define SETUP_REGISTER(hook) do \
}
}
#endif /* _MACH_UNIX */
-
- return;
}
#endif /* IN_CMPINT_C */
#define COMPILED_ENTRY_MAXIMUM_ARITY COMPILED_ENTRY_FORMAT_LOW
#define COMPILED_ENTRY_MINIMUM_ARITY COMPILED_ENTRY_FORMAT_HIGH
-#endif /* CMPINTMD_H_INCLUDED */
+#endif /* not SCM_CMPINTMD_H */
/* -*-C-*-
-$Id: cmptype.h,v 1.2 1999/01/02 06:11:34 cph Exp $
+$Id: cmptype.h,v 1.3 2000/12/05 21:23:43 cph Exp $
-Copyright (c) 1993, 1999 Massachusetts Institute of Technology
+Copyright (c) 1993, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
8 Motorola 88000 architecture (88100 and 88110).
Examples: ?
-9 Intel i386/i486/Pentium architecture.
+9 Intel IA-32 architecture.
Examples: IBM PC AT clones with 386+ processors.
10 DEC Alpha architecture
#define COMPILER_SPARC_TYPE 6
#define COMPILER_RS6000_TYPE 7
#define COMPILER_MC88K_TYPE 8
-#define COMPILER_I386_TYPE 9
+#define COMPILER_IA32_TYPE 9
#define COMPILER_ALPHA_TYPE 10
#define COMPILER_MIPS_TYPE 11
#define COMPILER_LOSING_C_TYPE 12
--- /dev/null
+#! /bin/sh
+# Attempt to guess a canonical system name.
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999
+# Free Software Foundation, Inc.
+#
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Written by Per Bothner <bothner@cygnus.com>.
+# The master version of this file is at the FSF in /home/gd/gnu/lib.
+# Please send patches to the Autoconf mailing list <autoconf@gnu.org>.
+#
+# This script attempts to guess a canonical system name similar to
+# config.sub. If it succeeds, it prints the system name on stdout, and
+# exits with 0. Otherwise, it exits with 1.
+#
+# The plan is that this can be called by configure scripts if you
+# don't specify an explicit system type (host/target name).
+#
+# Only a few systems have been added to this list; please add others
+# (but try to keep the structure clean).
+#
+
+# Use $HOST_CC if defined. $CC may point to a cross-compiler
+if test x"$CC_FOR_BUILD" = x; then
+ if test x"$HOST_CC" != x; then
+ CC_FOR_BUILD="$HOST_CC"
+ else
+ if test x"$CC" != x; then
+ CC_FOR_BUILD="$CC"
+ else
+ CC_FOR_BUILD=cc
+ fi
+ fi
+fi
+
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 8/24/94.)
+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+ PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+dummy=dummy-$$
+trap 'rm -f $dummy.c $dummy.o $dummy; exit 1' 1 2 15
+
+# Note: order is significant - the case branches are not exclusive.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+ alpha:OSF1:*:*)
+ if test $UNAME_RELEASE = "V4.0"; then
+ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+ fi
+ # A Vn.n version is a released version.
+ # A Tn.n version is a released field test version.
+ # A Xn.n version is an unreleased experimental baselevel.
+ # 1.2 uses "1.2" for uname -r.
+ cat <<EOF >$dummy.s
+ .globl main
+ .ent main
+main:
+ .frame \$30,0,\$26,0
+ .prologue 0
+ .long 0x47e03d80 # implver $0
+ lda \$2,259
+ .long 0x47e20c21 # amask $2,$1
+ srl \$1,8,\$2
+ sll \$2,2,\$2
+ sll \$0,3,\$0
+ addl \$1,\$0,\$0
+ addl \$2,\$0,\$0
+ ret \$31,(\$26),1
+ .end main
+EOF
+ $CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
+ if test "$?" = 0 ; then
+ ./$dummy
+ case "$?" in
+ 7)
+ UNAME_MACHINE="alpha"
+ ;;
+ 15)
+ UNAME_MACHINE="alphaev5"
+ ;;
+ 14)
+ UNAME_MACHINE="alphaev56"
+ ;;
+ 10)
+ UNAME_MACHINE="alphapca56"
+ ;;
+ 16)
+ UNAME_MACHINE="alphaev6"
+ ;;
+ esac
+ fi
+ rm -f $dummy.s $dummy
+ echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+ exit 0 ;;
+ Alpha\ *:Windows_NT*:*)
+ # How do we know it's Interix rather than the generic POSIX subsystem?
+ # Should we change UNAME_MACHINE based on the output of uname instead
+ # of the specific Alpha model?
+ echo alpha-pc-interix
+ exit 0 ;;
+ 21064:Windows_NT:50:3)
+ echo alpha-dec-winnt3.5
+ exit 0 ;;
+ Amiga*:UNIX_System_V:4.0:*)
+ echo m68k-cbm-sysv4
+ exit 0;;
+ amiga:NetBSD:*:*)
+ echo m68k-cbm-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ amiga:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ *:[Aa]miga[Oo][Ss]:*:*)
+ echo ${UNAME_MACHINE}-unknown-amigaos
+ exit 0 ;;
+ arc64:OpenBSD:*:*)
+ echo mips64el-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ arc:OpenBSD:*:*)
+ echo mipsel-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ hkmips:OpenBSD:*:*)
+ echo mips-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ pmax:OpenBSD:*:*)
+ echo mipsel-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ sgi:OpenBSD:*:*)
+ echo mips-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ wgrisc:OpenBSD:*:*)
+ echo mipsel-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+ echo arm-acorn-riscix${UNAME_RELEASE}
+ exit 0;;
+ arm32:NetBSD:*:*)
+ echo arm-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+ exit 0 ;;
+ SR2?01:HI-UX/MPP:*:*)
+ echo hppa1.1-hitachi-hiuxmpp
+ exit 0;;
+ Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+ # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+ if test "`(/bin/universe) 2>/dev/null`" = att ; then
+ echo pyramid-pyramid-sysv3
+ else
+ echo pyramid-pyramid-bsd
+ fi
+ exit 0 ;;
+ NILE*:*:*:dcosx)
+ echo pyramid-pyramid-svr4
+ exit 0 ;;
+ sun4H:SunOS:5.*:*)
+ echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+ echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ i86pc:SunOS:5.*:*)
+ echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:6*:*)
+ # According to config.sub, this is the proper way to canonicalize
+ # SunOS6. Hard to guess exactly what SunOS6 will be like, but
+ # it's likely to be more like Solaris than SunOS4.
+ echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:*:*)
+ case "`/usr/bin/arch -k`" in
+ Series*|S4*)
+ UNAME_RELEASE=`uname -v`
+ ;;
+ esac
+ # Japanese Language versions have a version number like `4.1.3-JL'.
+ echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
+ exit 0 ;;
+ sun3*:SunOS:*:*)
+ echo m68k-sun-sunos${UNAME_RELEASE}
+ exit 0 ;;
+ sun*:*:4.2BSD:*)
+ UNAME_RELEASE=`(head -1 /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+ test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3
+ case "`/bin/arch`" in
+ sun3)
+ echo m68k-sun-sunos${UNAME_RELEASE}
+ ;;
+ sun4)
+ echo sparc-sun-sunos${UNAME_RELEASE}
+ ;;
+ esac
+ exit 0 ;;
+ aushp:SunOS:*:*)
+ echo sparc-auspex-sunos${UNAME_RELEASE}
+ exit 0 ;;
+ atari*:NetBSD:*:*)
+ echo m68k-atari-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ atari*:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ # The situation for MiNT is a little confusing. The machine name
+ # can be virtually everything (everything which is not
+ # "atarist" or "atariste" at least should have a processor
+ # > m68000). The system name ranges from "MiNT" over "FreeMiNT"
+ # to the lowercase version "mint" (or "freemint"). Finally
+ # the system name "TOS" denotes a system which is actually not
+ # MiNT. But MiNT is downward compatible to TOS, so this should
+ # be no problem.
+ atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+ echo m68k-atari-mint${UNAME_RELEASE}
+ exit 0 ;;
+ atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+ echo m68k-atari-mint${UNAME_RELEASE}
+ exit 0 ;;
+ *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+ echo m68k-atari-mint${UNAME_RELEASE}
+ exit 0 ;;
+ milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+ echo m68k-milan-mint${UNAME_RELEASE}
+ exit 0 ;;
+ hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+ echo m68k-hades-mint${UNAME_RELEASE}
+ exit 0 ;;
+ *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+ echo m68k-unknown-mint${UNAME_RELEASE}
+ exit 0 ;;
+ sun3*:NetBSD:*:*)
+ echo m68k-sun-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ sun3*:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mac68k:NetBSD:*:*)
+ echo m68k-apple-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mac68k:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mvme68k:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mvme88k:OpenBSD:*:*)
+ echo m88k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ powerpc:machten:*:*)
+ echo powerpc-apple-machten${UNAME_RELEASE}
+ exit 0 ;;
+ macppc:NetBSD:*:*)
+ echo powerpc-apple-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ RISC*:Mach:*:*)
+ echo mips-dec-mach_bsd4.3
+ exit 0 ;;
+ RISC*:ULTRIX:*:*)
+ echo mips-dec-ultrix${UNAME_RELEASE}
+ exit 0 ;;
+ VAX*:ULTRIX*:*:*)
+ echo vax-dec-ultrix${UNAME_RELEASE}
+ exit 0 ;;
+ 2020:CLIX:*:* | 2430:CLIX:*:*)
+ echo clipper-intergraph-clix${UNAME_RELEASE}
+ exit 0 ;;
+ mips:*:*:UMIPS | mips:*:*:RISCos)
+ sed 's/^ //' << EOF >$dummy.c
+#ifdef __cplusplus
+ int main (int argc, char *argv[]) {
+#else
+ int main (argc, argv) int argc; char *argv[]; {
+#endif
+ #if defined (host_mips) && defined (MIPSEB)
+ #if defined (SYSTYPE_SYSV)
+ printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_SVR4)
+ printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+ printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+ #endif
+ #endif
+ exit (-1);
+ }
+EOF
+ $CC_FOR_BUILD $dummy.c -o $dummy \
+ && ./$dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \
+ && rm $dummy.c $dummy && exit 0
+ rm -f $dummy.c $dummy
+ echo mips-mips-riscos${UNAME_RELEASE}
+ exit 0 ;;
+ Night_Hawk:Power_UNIX:*:*)
+ echo powerpc-harris-powerunix
+ exit 0 ;;
+ m88k:CX/UX:7*:*)
+ echo m88k-harris-cxux7
+ exit 0 ;;
+ m88k:*:4*:R4*)
+ echo m88k-motorola-sysv4
+ exit 0 ;;
+ m88k:*:3*:R3*)
+ echo m88k-motorola-sysv3
+ exit 0 ;;
+ AViiON:dgux:*:*)
+ # DG/UX returns AViiON for all architectures
+ UNAME_PROCESSOR=`/usr/bin/uname -p`
+ if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88110 ] ; then
+ if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \
+ -o ${TARGET_BINARY_INTERFACE}x = x ] ; then
+ echo m88k-dg-dgux${UNAME_RELEASE}
+ else
+ echo m88k-dg-dguxbcs${UNAME_RELEASE}
+ fi
+ else echo i586-dg-dgux${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+ M88*:DolphinOS:*:*) # DolphinOS (SVR3)
+ echo m88k-dolphin-sysv3
+ exit 0 ;;
+ M88*:*:R3*:*)
+ # Delta 88k system running SVR3
+ echo m88k-motorola-sysv3
+ exit 0 ;;
+ XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+ echo m88k-tektronix-sysv3
+ exit 0 ;;
+ Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+ echo m68k-tektronix-bsd
+ exit 0 ;;
+ *:IRIX*:*:*)
+ echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+ exit 0 ;;
+ ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+ echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
+ exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX '
+ i?86:AIX:*:*)
+ echo i386-ibm-aix
+ exit 0 ;;
+ *:AIX:2:3)
+ if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+ sed 's/^ //' << EOF >$dummy.c
+ #include <sys/systemcfg.h>
+
+ main()
+ {
+ if (!__power_pc())
+ exit(1);
+ puts("powerpc-ibm-aix3.2.5");
+ exit(0);
+ }
+EOF
+ $CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm $dummy.c $dummy && exit 0
+ rm -f $dummy.c $dummy
+ echo rs6000-ibm-aix3.2.5
+ elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+ echo rs6000-ibm-aix3.2.4
+ else
+ echo rs6000-ibm-aix3.2
+ fi
+ exit 0 ;;
+ *:AIX:*:4)
+ IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | head -1 | awk '{ print $1 }'`
+ if /usr/sbin/lsattr -EHl ${IBM_CPU_ID} | grep POWER >/dev/null 2>&1; then
+ IBM_ARCH=rs6000
+ else
+ IBM_ARCH=powerpc
+ fi
+ if [ -x /usr/bin/oslevel ] ; then
+ IBM_REV=`/usr/bin/oslevel`
+ else
+ IBM_REV=4.${UNAME_RELEASE}
+ fi
+ echo ${IBM_ARCH}-ibm-aix${IBM_REV}
+ exit 0 ;;
+ *:AIX:*:*)
+ echo rs6000-ibm-aix
+ exit 0 ;;
+ ibmrt:4.4BSD:*|romp-ibm:BSD:*)
+ echo romp-ibm-bsd4.4
+ exit 0 ;;
+ ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and
+ echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
+ exit 0 ;; # report: romp-ibm BSD 4.3
+ *:BOSX:*:*)
+ echo rs6000-bull-bosx
+ exit 0 ;;
+ DPX/2?00:B.O.S.:*:*)
+ echo m68k-bull-sysv3
+ exit 0 ;;
+ 9000/[34]??:4.3bsd:1.*:*)
+ echo m68k-hp-bsd
+ exit 0 ;;
+ hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+ echo m68k-hp-bsd4.4
+ exit 0 ;;
+ 9000/[34678]??:HP-UX:*:*)
+ case "${UNAME_MACHINE}" in
+ 9000/31? ) HP_ARCH=m68000 ;;
+ 9000/[34]?? ) HP_ARCH=m68k ;;
+ 9000/[678][0-9][0-9])
+ sed 's/^ //' << EOF >$dummy.c
+ #include <stdlib.h>
+ #include <unistd.h>
+
+ int main ()
+ {
+ #if defined(_SC_KERNEL_BITS)
+ long bits = sysconf(_SC_KERNEL_BITS);
+ #endif
+ long cpu = sysconf (_SC_CPU_VERSION);
+
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+ case CPU_PA_RISC2_0:
+ #if defined(_SC_KERNEL_BITS)
+ switch (bits)
+ {
+ case 64: puts ("hppa2.0w"); break;
+ case 32: puts ("hppa2.0n"); break;
+ default: puts ("hppa2.0"); break;
+ } break;
+ #else /* !defined(_SC_KERNEL_BITS) */
+ puts ("hppa2.0"); break;
+ #endif
+ default: puts ("hppa1.0"); break;
+ }
+ exit (0);
+ }
+EOF
+ ($CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null ) && HP_ARCH=`./$dummy`
+ rm -f $dummy.c $dummy
+ esac
+ HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+ echo ${HP_ARCH}-hp-hpux${HPUX_REV}
+ exit 0 ;;
+ 3050*:HI-UX:*:*)
+ sed 's/^ //' << EOF >$dummy.c
+ #include <unistd.h>
+ int
+ main ()
+ {
+ long cpu = sysconf (_SC_CPU_VERSION);
+ /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+ true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
+ results, however. */
+ if (CPU_IS_PA_RISC (cpu))
+ {
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+ default: puts ("hppa-hitachi-hiuxwe2"); break;
+ }
+ }
+ else if (CPU_IS_HP_MC68K (cpu))
+ puts ("m68k-hitachi-hiuxwe2");
+ else puts ("unknown-hitachi-hiuxwe2");
+ exit (0);
+ }
+EOF
+ $CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm $dummy.c $dummy && exit 0
+ rm -f $dummy.c $dummy
+ echo unknown-hitachi-hiuxwe2
+ exit 0 ;;
+ 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
+ echo hppa1.1-hp-bsd
+ exit 0 ;;
+ 9000/8??:4.3bsd:*:*)
+ echo hppa1.0-hp-bsd
+ exit 0 ;;
+ *9??*:MPE/iX:*:*)
+ echo hppa1.0-hp-mpeix
+ exit 0 ;;
+ hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
+ echo hppa1.1-hp-osf
+ exit 0 ;;
+ hp8??:OSF1:*:*)
+ echo hppa1.0-hp-osf
+ exit 0 ;;
+ i?86:OSF1:*:*)
+ if [ -x /usr/sbin/sysversion ] ; then
+ echo ${UNAME_MACHINE}-unknown-osf1mk
+ else
+ echo ${UNAME_MACHINE}-unknown-osf1
+ fi
+ exit 0 ;;
+ parisc*:Lites*:*:*)
+ echo hppa1.1-hp-lites
+ exit 0 ;;
+ hppa*:OpenBSD:*:*)
+ echo hppa-unknown-openbsd
+ exit 0 ;;
+ C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+ echo c1-convex-bsd
+ exit 0 ;;
+ C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit 0 ;;
+ C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+ echo c34-convex-bsd
+ exit 0 ;;
+ C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+ echo c38-convex-bsd
+ exit 0 ;;
+ C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+ echo c4-convex-bsd
+ exit 0 ;;
+ CRAY*X-MP:*:*:*)
+ echo xmp-cray-unicos
+ exit 0 ;;
+ CRAY*Y-MP:*:*:*)
+ echo ymp-cray-unicos${UNAME_RELEASE}
+ exit 0 ;;
+ CRAY*[A-Z]90:*:*:*)
+ echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
+ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/
+ exit 0 ;;
+ CRAY*TS:*:*:*)
+ echo t90-cray-unicos${UNAME_RELEASE}
+ exit 0 ;;
+ CRAY*T3E:*:*:*)
+ echo alpha-cray-unicosmk${UNAME_RELEASE}
+ exit 0 ;;
+ CRAY-2:*:*:*)
+ echo cray2-cray-unicos
+ exit 0 ;;
+ F300:UNIX_System_V:*:*)
+ FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+ FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
+ echo "f300-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+ exit 0 ;;
+ F301:UNIX_System_V:*:*)
+ echo f301-fujitsu-uxpv`echo $UNAME_RELEASE | sed 's/ .*//'`
+ exit 0 ;;
+ hp3[0-9][05]:NetBSD:*:*)
+ echo m68k-hp-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ hp300:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ i?86:BSD/386:*:* | i?86:BSD/OS:*:*)
+ echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+ sparc*:BSD/OS:*:*)
+ echo sparc-unknown-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+ *:BSD/OS:*:*)
+ echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+ *:FreeBSD:*:*)
+ if test -x /usr/bin/objformat; then
+ if test "elf" = "`/usr/bin/objformat`"; then
+ echo ${UNAME_MACHINE}-unknown-freebsdelf`echo ${UNAME_RELEASE}|sed -e 's/[-_].*//'`
+ exit 0
+ fi
+ fi
+ echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+ exit 0 ;;
+ *:NetBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+ exit 0 ;;
+ *:OpenBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-openbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+ exit 0 ;;
+ i*:CYGWIN*:*)
+ echo ${UNAME_MACHINE}-pc-cygwin
+ exit 0 ;;
+ i*:MINGW*:*)
+ echo ${UNAME_MACHINE}-pc-mingw32
+ exit 0 ;;
+ i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
+ # How do we know it's Interix rather than the generic POSIX subsystem?
+ # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
+ # UNAME_MACHINE based on the output of uname instead of i386?
+ echo i386-pc-interix
+ exit 0 ;;
+ i*:UWIN*:*)
+ echo ${UNAME_MACHINE}-pc-uwin
+ exit 0 ;;
+ p*:CYGWIN*:*)
+ echo powerpcle-unknown-cygwin
+ exit 0 ;;
+ prep*:SunOS:5.*:*)
+ echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ *:GNU:*:*)
+ echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+ exit 0 ;;
+ *:Linux:*:*)
+ # uname on the ARM produces all sorts of strangeness, and we need to
+ # filter it out.
+ case "$UNAME_MACHINE" in
+ armv*) UNAME_MACHINE=$UNAME_MACHINE ;;
+ arm* | sa110*) UNAME_MACHINE="arm" ;;
+ esac
+
+ # The BFD linker knows what the default object file format is, so
+ # first see if it will tell us. cd to the root directory to prevent
+ # problems with other programs or directories called `ld' in the path.
+ ld_help_string=`cd /; ld --help 2>&1`
+ ld_supported_emulations=`echo $ld_help_string \
+ | sed -ne '/supported emulations:/!d
+ s/[ ][ ]*/ /g
+ s/.*supported emulations: *//
+ s/ .*//
+ p'`
+ case "$ld_supported_emulations" in
+ *ia64) echo "${UNAME_MACHINE}-unknown-linux" ; exit 0 ;;
+ i?86linux) echo "${UNAME_MACHINE}-pc-linux-gnuaout" ; exit 0 ;;
+ i?86coff) echo "${UNAME_MACHINE}-pc-linux-gnucoff" ; exit 0 ;;
+ sparclinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;;
+ armlinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;;
+ m68klinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;;
+ elf32ppc | elf32ppclinux)
+ # Determine Lib Version
+ cat >$dummy.c <<EOF
+#include <features.h>
+#if defined(__GLIBC__)
+extern char __libc_version[];
+extern char __libc_release[];
+#endif
+main(argc, argv)
+ int argc;
+ char *argv[];
+{
+#if defined(__GLIBC__)
+ printf("%s %s\n", __libc_version, __libc_release);
+#else
+ printf("unkown\n");
+#endif
+ return 0;
+}
+EOF
+ LIBC=""
+ $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null
+ if test "$?" = 0 ; then
+ ./$dummy | grep 1\.99 > /dev/null
+ if test "$?" = 0 ; then
+ LIBC="libc1"
+ fi
+ fi
+ rm -f $dummy.c $dummy
+ echo powerpc-unknown-linux-gnu${LIBC} ; exit 0 ;;
+ esac
+
+ if test "${UNAME_MACHINE}" = "alpha" ; then
+ sed 's/^ //' <<EOF >$dummy.s
+ .globl main
+ .ent main
+ main:
+ .frame \$30,0,\$26,0
+ .prologue 0
+ .long 0x47e03d80 # implver $0
+ lda \$2,259
+ .long 0x47e20c21 # amask $2,$1
+ srl \$1,8,\$2
+ sll \$2,2,\$2
+ sll \$0,3,\$0
+ addl \$1,\$0,\$0
+ addl \$2,\$0,\$0
+ ret \$31,(\$26),1
+ .end main
+EOF
+ LIBC=""
+ $CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
+ if test "$?" = 0 ; then
+ ./$dummy
+ case "$?" in
+ 7)
+ UNAME_MACHINE="alpha"
+ ;;
+ 15)
+ UNAME_MACHINE="alphaev5"
+ ;;
+ 14)
+ UNAME_MACHINE="alphaev56"
+ ;;
+ 10)
+ UNAME_MACHINE="alphapca56"
+ ;;
+ 16)
+ UNAME_MACHINE="alphaev6"
+ ;;
+ esac
+
+ objdump --private-headers $dummy | \
+ grep ld.so.1 > /dev/null
+ if test "$?" = 0 ; then
+ LIBC="libc1"
+ fi
+ fi
+ rm -f $dummy.s $dummy
+ echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} ; exit 0
+ elif test "${UNAME_MACHINE}" = "mips" ; then
+ cat >$dummy.c <<EOF
+#ifdef __cplusplus
+ int main (int argc, char *argv[]) {
+#else
+ int main (argc, argv) int argc; char *argv[]; {
+#endif
+#ifdef __MIPSEB__
+ printf ("%s-unknown-linux-gnu\n", argv[1]);
+#endif
+#ifdef __MIPSEL__
+ printf ("%sel-unknown-linux-gnu\n", argv[1]);
+#endif
+ return 0;
+}
+EOF
+ $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0
+ rm -f $dummy.c $dummy
+ else
+ # Either a pre-BFD a.out linker (linux-gnuoldld)
+ # or one that does not give us useful --help.
+ # GCC wants to distinguish between linux-gnuoldld and linux-gnuaout.
+ # If ld does not provide *any* "supported emulations:"
+ # that means it is gnuoldld.
+ echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations:"
+ test $? != 0 && echo "${UNAME_MACHINE}-pc-linux-gnuoldld" && exit 0
+
+ case "${UNAME_MACHINE}" in
+ i?86)
+ VENDOR=pc;
+ ;;
+ *)
+ VENDOR=unknown;
+ ;;
+ esac
+ # Determine whether the default compiler is a.out or elf
+ cat >$dummy.c <<EOF
+#include <features.h>
+#ifdef __cplusplus
+ int main (int argc, char *argv[]) {
+#else
+ int main (argc, argv) int argc; char *argv[]; {
+#endif
+#ifdef __ELF__
+# ifdef __GLIBC__
+# if __GLIBC__ >= 2
+ printf ("%s-${VENDOR}-linux-gnu\n", argv[1]);
+# else
+ printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]);
+# endif
+# else
+ printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]);
+# endif
+#else
+ printf ("%s-${VENDOR}-linux-gnuaout\n", argv[1]);
+#endif
+ return 0;
+}
+EOF
+ $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0
+ rm -f $dummy.c $dummy
+ fi ;;
+# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions
+# are messed up and put the nodename in both sysname and nodename.
+ i?86:DYNIX/ptx:4*:*)
+ echo i386-sequent-sysv4
+ exit 0 ;;
+ i?86:UNIX_SV:4.2MP:2.*)
+ # Unixware is an offshoot of SVR4, but it has its own version
+ # number series starting with 2...
+ # I am not positive that other SVR4 systems won't match this,
+ # I just have to hope. -- rms.
+ # Use sysv4.2uw... so that sysv4* matches it.
+ echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
+ exit 0 ;;
+ i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*)
+ if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+ echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE}
+ else
+ echo ${UNAME_MACHINE}-pc-sysv${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+ i?86:*:5:7*)
+ UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')`
+ (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486
+ (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) && UNAME_MACHINE=i586
+ (/bin/uname -X|egrep '^Machine.*Pent.*II' >/dev/null) && UNAME_MACHINE=i686
+ (/bin/uname -X|egrep '^Machine.*Pentium Pro' >/dev/null) && UNAME_MACHINE=i585
+ echo ${UNAME_MACHINE}-${UNAME_SYSTEM}${UNAME_VERSION}-sysv${UNAME_RELEASE}
+ exit 0 ;;
+ i?86:*:3.2:*)
+ if test -f /usr/options/cb.name; then
+ UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+ echo ${UNAME_MACHINE}-pc-isc$UNAME_REL
+ elif /bin/uname -X 2>/dev/null >/dev/null ; then
+ UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')`
+ (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486
+ (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \
+ && UNAME_MACHINE=i586
+ (/bin/uname -X|egrep '^Machine.*Pent ?II' >/dev/null) \
+ && UNAME_MACHINE=i686
+ (/bin/uname -X|egrep '^Machine.*Pentium Pro' >/dev/null) \
+ && UNAME_MACHINE=i686
+ echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
+ else
+ echo ${UNAME_MACHINE}-pc-sysv32
+ fi
+ exit 0 ;;
+ pc:*:*:*)
+ # uname -m prints for DJGPP always 'pc', but it prints nothing about
+ # the processor, so we play safe by assuming i386.
+ echo i386-pc-msdosdjgpp
+ exit 0 ;;
+ Intel:Mach:3*:*)
+ echo i386-pc-mach3
+ exit 0 ;;
+ paragon:*:*:*)
+ echo i860-intel-osf1
+ exit 0 ;;
+ i860:*:4.*:*) # i860-SVR4
+ if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+ echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
+ else # Add other i860-SVR4 vendors below as they are discovered.
+ echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4
+ fi
+ exit 0 ;;
+ mini*:CTIX:SYS*5:*)
+ # "miniframe"
+ echo m68010-convergent-sysv
+ exit 0 ;;
+ M68*:*:R3V[567]*:*)
+ test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
+ 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 4850:*:4.0:3.0)
+ OS_REL=''
+ test -r /etc/.relid \
+ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4.3${OS_REL} && exit 0
+ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+ && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;;
+ 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4 && exit 0 ;;
+ m68*:LynxOS:2.*:*)
+ echo m68k-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ mc68030:UNIX_System_V:4.*:*)
+ echo m68k-atari-sysv4
+ exit 0 ;;
+ i?86:LynxOS:2.*:* | i?86:LynxOS:3.[01]*:*)
+ echo i386-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ TSUNAMI:LynxOS:2.*:*)
+ echo sparc-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ rs6000:LynxOS:2.*:* | PowerPC:LynxOS:2.*:*)
+ echo rs6000-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ SM[BE]S:UNIX_SV:*:*)
+ echo mips-dde-sysv${UNAME_RELEASE}
+ exit 0 ;;
+ RM*:ReliantUNIX-*:*:*)
+ echo mips-sni-sysv4
+ exit 0 ;;
+ RM*:SINIX-*:*:*)
+ echo mips-sni-sysv4
+ exit 0 ;;
+ *:SINIX-*:*:*)
+ if uname -p 2>/dev/null >/dev/null ; then
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ echo ${UNAME_MACHINE}-sni-sysv4
+ else
+ echo ns32k-sni-sysv
+ fi
+ exit 0 ;;
+ PENTIUM:CPunix:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+ # says <Richard.M.Bartel@ccMail.Census.GOV>
+ echo i586-unisys-sysv4
+ exit 0 ;;
+ *:UNIX_System_V:4*:FTX*)
+ # From Gerald Hewes <hewes@openmarket.com>.
+ # How about differentiating between stratus architectures? -djm
+ echo hppa1.1-stratus-sysv4
+ exit 0 ;;
+ *:*:*:FTX*)
+ # From seanf@swdc.stratus.com.
+ echo i860-stratus-sysv4
+ exit 0 ;;
+ mc68*:A/UX:*:*)
+ echo m68k-apple-aux${UNAME_RELEASE}
+ exit 0 ;;
+ news*:NEWS-OS:*:6*)
+ echo mips-sony-newsos6
+ exit 0 ;;
+ R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+ if [ -d /usr/nec ]; then
+ echo mips-nec-sysv${UNAME_RELEASE}
+ else
+ echo mips-unknown-sysv${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+ BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
+ echo powerpc-be-beos
+ exit 0 ;;
+ BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only.
+ echo powerpc-apple-beos
+ exit 0 ;;
+ BePC:BeOS:*:*) # BeOS running on Intel PC compatible.
+ echo i586-pc-beos
+ exit 0 ;;
+ SX-4:SUPER-UX:*:*)
+ echo sx4-nec-superux${UNAME_RELEASE}
+ exit 0 ;;
+ SX-5:SUPER-UX:*:*)
+ echo sx5-nec-superux${UNAME_RELEASE}
+ exit 0 ;;
+ Power*:Rhapsody:*:*)
+ echo powerpc-apple-rhapsody${UNAME_RELEASE}
+ exit 0 ;;
+ *:Rhapsody:*:*)
+ echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
+ exit 0 ;;
+esac
+
+#echo '(No uname command or uname output not recognized.)' 1>&2
+#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
+
+cat >$dummy.c <<EOF
+#ifdef _SEQUENT_
+# include <sys/types.h>
+# include <sys/utsname.h>
+#endif
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+ /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
+ I don't know.... */
+ printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include <sys/param.h>
+ printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+ "4"
+#else
+ ""
+#endif
+ ); exit (0);
+#endif
+#endif
+
+#if defined (__arm) && defined (__acorn) && defined (__unix)
+ printf ("arm-acorn-riscix"); exit (0);
+#endif
+
+#if defined (hp300) && !defined (hpux)
+ printf ("m68k-hp-bsd\n"); exit (0);
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+ if (version < 4)
+ printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+ else
+ printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+ exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+ printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+ printf ("ns32k-encore-mach\n"); exit (0);
+#else
+ printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+ printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+ printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+ printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+ struct utsname un;
+
+ uname(&un);
+
+ if (strncmp(un.version, "V2", 2) == 0) {
+ printf ("i386-sequent-ptx2\n"); exit (0);
+ }
+ if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+ printf ("i386-sequent-ptx1\n"); exit (0);
+ }
+ printf ("i386-sequent-ptx\n"); exit (0);
+
+#endif
+
+#if defined (vax)
+#if !defined (ultrix)
+ printf ("vax-dec-bsd\n"); exit (0);
+#else
+ printf ("vax-dec-ultrix\n"); exit (0);
+#endif
+#endif
+
+#if defined (alliant) && defined (i860)
+ printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+ exit (1);
+}
+EOF
+
+$CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy && rm $dummy.c $dummy && exit 0
+rm -f $dummy.c $dummy
+
+# Apollos put the system type in the environment.
+
+test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; }
+
+# Convex versions that predate uname can use getsysinfo(1)
+
+if [ -x /usr/convex/getsysinfo ]
+then
+ case `getsysinfo -f cpu_type` in
+ c1*)
+ echo c1-convex-bsd
+ exit 0 ;;
+ c2*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit 0 ;;
+ c34*)
+ echo c34-convex-bsd
+ exit 0 ;;
+ c38*)
+ echo c38-convex-bsd
+ exit 0 ;;
+ c4*)
+ echo c4-convex-bsd
+ exit 0 ;;
+ esac
+fi
+
+#echo '(Unable to guess system type)' 1>&2
+
+exit 1
--- /dev/null
+#! /bin/sh
+# Configuration validation subroutine script, version 1.1.
+# Copyright (C) 1991, 92-97, 1998, 1999 Free Software Foundation, Inc.
+# This file is (in principle) common to ALL GNU software.
+# The presence of a machine in this file suggests that SOME GNU software
+# can handle that machine. It does not imply ALL GNU software can.
+#
+# This file is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support. The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+if [ x$1 = x ]
+then
+ echo Configuration name missing. 1>&2
+ echo "Usage: $0 CPU-MFR-OPSYS" 1>&2
+ echo "or $0 ALIAS" 1>&2
+ echo where ALIAS is a recognized configuration type. 1>&2
+ exit 1
+fi
+
+# First pass through any local machine types.
+case $1 in
+ *local*)
+ echo $1
+ exit 0
+ ;;
+ *)
+ ;;
+esac
+
+# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
+# Here we must recognize all the valid KERNEL-OS combinations.
+maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
+case $maybe_os in
+ linux-gnu*)
+ os=-$maybe_os
+ basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
+ ;;
+ *)
+ basic_machine=`echo $1 | sed 's/-[^-]*$//'`
+ if [ $basic_machine != $1 ]
+ then os=`echo $1 | sed 's/.*-/-/'`
+ else os=; fi
+ ;;
+esac
+
+### Let's recognize common machines as not being operating systems so
+### that things like config.sub decstation-3100 work. We also
+### recognize some manufacturers as not being operating systems, so we
+### can provide default operating systems below.
+case $os in
+ -sun*os*)
+ # Prevent following clause from handling this invalid input.
+ ;;
+ -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
+ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
+ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
+ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
+ -apple)
+ os=
+ basic_machine=$1
+ ;;
+ -sim | -cisco | -oki | -wec | -winbond)
+ os=
+ basic_machine=$1
+ ;;
+ -scout)
+ ;;
+ -wrs)
+ os=vxworks
+ basic_machine=$1
+ ;;
+ -hiux*)
+ os=-hiuxwe2
+ ;;
+ -sco5)
+ os=-sco3.2v5
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco4)
+ os=-sco3.2v4
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco3.2.[4-9]*)
+ os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco3.2v[4-9]*)
+ # Don't forget version if it is 3.2v4 or newer.
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco*)
+ os=-sco3.2v2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -udk*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -isc)
+ os=-isc2.2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -clix*)
+ basic_machine=clipper-intergraph
+ ;;
+ -isc*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -lynx*)
+ os=-lynxos
+ ;;
+ -ptx*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+ ;;
+ -windowsnt*)
+ os=`echo $os | sed -e 's/windowsnt/winnt/'`
+ ;;
+ -psos*)
+ os=-psos
+ ;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+ # Recognize the basic CPU types without company name.
+ # Some are omitted here because they have special meanings below.
+ tahoe | i860 | ia64 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \
+ | arme[lb] | pyramid | mn10200 | mn10300 | tron | a29k \
+ | 580 | i960 | h8300 \
+ | hppa | hppa1.0 | hppa1.1 | hppa2.0 | hppa2.0w | hppa2.0n \
+ | alpha | alphaev[4-7] | alphaev56 | alphapca5[67] \
+ | we32k | ns16k | clipper | i370 | sh | powerpc | powerpcle \
+ | 1750a | dsp16xx | pdp11 | mips16 | mips64 | mipsel | mips64el \
+ | mips64orion | mips64orionel | mipstx39 | mipstx39el \
+ | mips64vr4300 | mips64vr4300el | mips64vr4100 | mips64vr4100el \
+ | mips64vr5000 | miprs64vr5000el | mcore \
+ | sparc | sparclet | sparclite | sparc64 | sparcv9 | v850 | c4x \
+ | thumb | d10v)
+ basic_machine=$basic_machine-unknown
+ ;;
+ m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | z8k | v70 | h8500 | w65)
+ ;;
+
+ # We use `pc' rather than `unknown'
+ # because (1) that's what they normally are, and
+ # (2) the word "unknown" tends to confuse beginning users.
+ i[34567]86)
+ basic_machine=$basic_machine-pc
+ ;;
+ # Object if more than one company name word.
+ *-*-*)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+ # Recognize the basic CPU types with company name.
+ # FIXME: clean up the formatting here.
+ vax-* | tahoe-* | i[34567]86-* | i860-* | ia64-* | m32r-* | m68k-* | m68000-* \
+ | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \
+ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \
+ | power-* | none-* | 580-* | cray2-* | h8300-* | h8500-* | i960-* \
+ | xmp-* | ymp-* \
+ | hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* | hppa2.0w-* | hppa2.0n-* \
+ | alpha-* | alphaev[4-7]-* | alphaev56-* | alphapca5[67]-* \
+ | we32k-* | cydra-* | ns16k-* | pn-* | np1-* | xps100-* \
+ | clipper-* | orion-* \
+ | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \
+ | sparc64-* | sparcv9-* | sparc86x-* | mips16-* | mips64-* | mipsel-* \
+ | mips64el-* | mips64orion-* | mips64orionel-* \
+ | mips64vr4100-* | mips64vr4100el-* | mips64vr4300-* | mips64vr4300el-* \
+ | mipstx39-* | mipstx39el-* | mcore-* \
+ | f301-* | armv*-* | t3e-* \
+ | m88110-* | m680[01234]0-* | m683?2-* | m68360-* | z8k-* | d10v-* \
+ | thumb-* | v850-* | d30v-* | tic30-* | c30-* )
+ ;;
+ # Recognize the various machine names and aliases which stand
+ # for a CPU type and a company and sometimes even an OS.
+ 386bsd)
+ basic_machine=i386-unknown
+ os=-bsd
+ ;;
+ 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+ basic_machine=m68000-att
+ ;;
+ 3b*)
+ basic_machine=we32k-att
+ ;;
+ a29khif)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ adobe68k)
+ basic_machine=m68010-adobe
+ os=-scout
+ ;;
+ alliant | fx80)
+ basic_machine=fx80-alliant
+ ;;
+ altos | altos3068)
+ basic_machine=m68k-altos
+ ;;
+ am29k)
+ basic_machine=a29k-none
+ os=-bsd
+ ;;
+ amdahl)
+ basic_machine=580-amdahl
+ os=-sysv
+ ;;
+ amiga | amiga-*)
+ basic_machine=m68k-cbm
+ ;;
+ amigaos | amigados)
+ basic_machine=m68k-cbm
+ os=-amigaos
+ ;;
+ amigaunix | amix)
+ basic_machine=m68k-cbm
+ os=-sysv4
+ ;;
+ apollo68)
+ basic_machine=m68k-apollo
+ os=-sysv
+ ;;
+ apollo68bsd)
+ basic_machine=m68k-apollo
+ os=-bsd
+ ;;
+ aux)
+ basic_machine=m68k-apple
+ os=-aux
+ ;;
+ balance)
+ basic_machine=ns32k-sequent
+ os=-dynix
+ ;;
+ convex-c1)
+ basic_machine=c1-convex
+ os=-bsd
+ ;;
+ convex-c2)
+ basic_machine=c2-convex
+ os=-bsd
+ ;;
+ convex-c32)
+ basic_machine=c32-convex
+ os=-bsd
+ ;;
+ convex-c34)
+ basic_machine=c34-convex
+ os=-bsd
+ ;;
+ convex-c38)
+ basic_machine=c38-convex
+ os=-bsd
+ ;;
+ cray | ymp)
+ basic_machine=ymp-cray
+ os=-unicos
+ ;;
+ cray2)
+ basic_machine=cray2-cray
+ os=-unicos
+ ;;
+ [ctj]90-cray)
+ basic_machine=c90-cray
+ os=-unicos
+ ;;
+ crds | unos)
+ basic_machine=m68k-crds
+ ;;
+ da30 | da30-*)
+ basic_machine=m68k-da30
+ ;;
+ decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
+ basic_machine=mips-dec
+ ;;
+ delta | 3300 | motorola-3300 | motorola-delta \
+ | 3300-motorola | delta-motorola)
+ basic_machine=m68k-motorola
+ ;;
+ delta88)
+ basic_machine=m88k-motorola
+ os=-sysv3
+ ;;
+ dpx20 | dpx20-*)
+ basic_machine=rs6000-bull
+ os=-bosx
+ ;;
+ dpx2* | dpx2*-bull)
+ basic_machine=m68k-bull
+ os=-sysv3
+ ;;
+ ebmon29k)
+ basic_machine=a29k-amd
+ os=-ebmon
+ ;;
+ elxsi)
+ basic_machine=elxsi-elxsi
+ os=-bsd
+ ;;
+ encore | umax | mmax)
+ basic_machine=ns32k-encore
+ ;;
+ es1800 | OSE68k | ose68k | ose | OSE)
+ basic_machine=m68k-ericsson
+ os=-ose
+ ;;
+ fx2800)
+ basic_machine=i860-alliant
+ ;;
+ genix)
+ basic_machine=ns32k-ns
+ ;;
+ gmicro)
+ basic_machine=tron-gmicro
+ os=-sysv
+ ;;
+ h3050r* | hiux*)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ h8300hms)
+ basic_machine=h8300-hitachi
+ os=-hms
+ ;;
+ h8300xray)
+ basic_machine=h8300-hitachi
+ os=-xray
+ ;;
+ h8500hms)
+ basic_machine=h8500-hitachi
+ os=-hms
+ ;;
+ harris)
+ basic_machine=m88k-harris
+ os=-sysv3
+ ;;
+ hp300-*)
+ basic_machine=m68k-hp
+ ;;
+ hp300bsd)
+ basic_machine=m68k-hp
+ os=-bsd
+ ;;
+ hp300hpux)
+ basic_machine=m68k-hp
+ os=-hpux
+ ;;
+ hp3k9[0-9][0-9] | hp9[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hp9k2[0-9][0-9] | hp9k31[0-9])
+ basic_machine=m68000-hp
+ ;;
+ hp9k3[2-9][0-9])
+ basic_machine=m68k-hp
+ ;;
+ hp9k6[0-9][0-9] | hp6[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hp9k7[0-79][0-9] | hp7[0-79][0-9])
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k78[0-9] | hp78[0-9])
+ # FIXME: really hppa2.0-hp
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+ # FIXME: really hppa2.0-hp
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[0-9][13679] | hp8[0-9][13679])
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[0-9][0-9] | hp8[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hppa-next)
+ os=-nextstep3
+ ;;
+ hppaosf)
+ basic_machine=hppa1.1-hp
+ os=-osf
+ ;;
+ hppro)
+ basic_machine=hppa1.1-hp
+ os=-proelf
+ ;;
+ i370-ibm* | ibm*)
+ basic_machine=i370-ibm
+ os=-mvs
+ ;;
+# I'm not sure what "Sysv32" means. Should this be sysv3.2?
+ i[34567]86v32)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv32
+ ;;
+ i[34567]86v4*)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv4
+ ;;
+ i[34567]86v)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv
+ ;;
+ i[34567]86sol2)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-solaris2
+ ;;
+ i386mach)
+ basic_machine=i386-mach
+ os=-mach
+ ;;
+ i386-vsta | vsta)
+ basic_machine=i386-unknown
+ os=-vsta
+ ;;
+ i386-go32 | go32)
+ basic_machine=i386-unknown
+ os=-go32
+ ;;
+ i386-mingw32 | mingw32)
+ basic_machine=i386-unknown
+ os=-mingw32
+ ;;
+ iris | iris4d)
+ basic_machine=mips-sgi
+ case $os in
+ -irix*)
+ ;;
+ *)
+ os=-irix4
+ ;;
+ esac
+ ;;
+ isi68 | isi)
+ basic_machine=m68k-isi
+ os=-sysv
+ ;;
+ m88k-omron*)
+ basic_machine=m88k-omron
+ ;;
+ magnum | m3230)
+ basic_machine=mips-mips
+ os=-sysv
+ ;;
+ merlin)
+ basic_machine=ns32k-utek
+ os=-sysv
+ ;;
+ miniframe)
+ basic_machine=m68000-convergent
+ ;;
+ *mint | *MiNT)
+ basic_machine=m68k-atari
+ os=-mint
+ ;;
+ mipsel*-linux*)
+ basic_machine=mipsel-unknown
+ os=-linux-gnu
+ ;;
+ mips*-linux*)
+ basic_machine=mips-unknown
+ os=-linux-gnu
+ ;;
+ mips3*-*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
+ ;;
+ mips3*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
+ ;;
+ monitor)
+ basic_machine=m68k-rom68k
+ os=-coff
+ ;;
+ msdos)
+ basic_machine=i386-unknown
+ os=-msdos
+ ;;
+ ncr3000)
+ basic_machine=i486-ncr
+ os=-sysv4
+ ;;
+ netbsd386)
+ basic_machine=i386-unknown
+ os=-netbsd
+ ;;
+ netwinder)
+ basic_machine=armv4l-corel
+ os=-linux
+ ;;
+ news | news700 | news800 | news900)
+ basic_machine=m68k-sony
+ os=-newsos
+ ;;
+ news1000)
+ basic_machine=m68030-sony
+ os=-newsos
+ ;;
+ news-3600 | risc-news)
+ basic_machine=mips-sony
+ os=-newsos
+ ;;
+ necv70)
+ basic_machine=v70-nec
+ os=-sysv
+ ;;
+ next | m*-next )
+ basic_machine=m68k-next
+ case $os in
+ -nextstep* )
+ ;;
+ -ns2*)
+ os=-nextstep2
+ ;;
+ *)
+ os=-nextstep3
+ ;;
+ esac
+ ;;
+ nh3000)
+ basic_machine=m68k-harris
+ os=-cxux
+ ;;
+ nh[45]000)
+ basic_machine=m88k-harris
+ os=-cxux
+ ;;
+ nindy960)
+ basic_machine=i960-intel
+ os=-nindy
+ ;;
+ mon960)
+ basic_machine=i960-intel
+ os=-mon960
+ ;;
+ np1)
+ basic_machine=np1-gould
+ ;;
+ op50n-* | op60c-*)
+ basic_machine=hppa1.1-oki
+ os=-proelf
+ ;;
+ OSE68000 | ose68000)
+ basic_machine=m68000-ericsson
+ os=-ose
+ ;;
+ os68k)
+ basic_machine=m68k-none
+ os=-os68k
+ ;;
+ pa-hitachi)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ paragon)
+ basic_machine=i860-intel
+ os=-osf
+ ;;
+ pbd)
+ basic_machine=sparc-tti
+ ;;
+ pbb)
+ basic_machine=m68k-tti
+ ;;
+ pc532 | pc532-*)
+ basic_machine=ns32k-pc532
+ ;;
+ pentium | p5 | k5 | k6 | nexen)
+ basic_machine=i586-pc
+ ;;
+ pentiumpro | p6 | 6x86)
+ basic_machine=i686-pc
+ ;;
+ pentiumii | pentium2)
+ basic_machine=i786-pc
+ ;;
+ pentium-* | p5-* | k5-* | k6-* | nexen-*)
+ basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pentiumpro-* | p6-* | 6x86-*)
+ basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pentiumii-* | pentium2-*)
+ basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pn)
+ basic_machine=pn-gould
+ ;;
+ power) basic_machine=rs6000-ibm
+ ;;
+ ppc) basic_machine=powerpc-unknown
+ ;;
+ ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ppcle | powerpclittle | ppc-le | powerpc-little)
+ basic_machine=powerpcle-unknown
+ ;;
+ ppcle-* | powerpclittle-*)
+ basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ps2)
+ basic_machine=i386-ibm
+ ;;
+ rom68k)
+ basic_machine=m68k-rom68k
+ os=-coff
+ ;;
+ rm[46]00)
+ basic_machine=mips-siemens
+ ;;
+ rtpc | rtpc-*)
+ basic_machine=romp-ibm
+ ;;
+ sa29200)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ sequent)
+ basic_machine=i386-sequent
+ ;;
+ sh)
+ basic_machine=sh-hitachi
+ os=-hms
+ ;;
+ sparclite-wrs)
+ basic_machine=sparclite-wrs
+ os=-vxworks
+ ;;
+ sps7)
+ basic_machine=m68k-bull
+ os=-sysv2
+ ;;
+ spur)
+ basic_machine=spur-unknown
+ ;;
+ st2000)
+ basic_machine=m68k-tandem
+ ;;
+ stratus)
+ basic_machine=i860-stratus
+ os=-sysv4
+ ;;
+ sun2)
+ basic_machine=m68000-sun
+ ;;
+ sun2os3)
+ basic_machine=m68000-sun
+ os=-sunos3
+ ;;
+ sun2os4)
+ basic_machine=m68000-sun
+ os=-sunos4
+ ;;
+ sun3os3)
+ basic_machine=m68k-sun
+ os=-sunos3
+ ;;
+ sun3os4)
+ basic_machine=m68k-sun
+ os=-sunos4
+ ;;
+ sun4os3)
+ basic_machine=sparc-sun
+ os=-sunos3
+ ;;
+ sun4os4)
+ basic_machine=sparc-sun
+ os=-sunos4
+ ;;
+ sun4sol2)
+ basic_machine=sparc-sun
+ os=-solaris2
+ ;;
+ sun3 | sun3-*)
+ basic_machine=m68k-sun
+ ;;
+ sun4)
+ basic_machine=sparc-sun
+ ;;
+ sun386 | sun386i | roadrunner)
+ basic_machine=i386-sun
+ ;;
+ symmetry)
+ basic_machine=i386-sequent
+ os=-dynix
+ ;;
+ t3e)
+ basic_machine=t3e-cray
+ os=-unicos
+ ;;
+ tx39)
+ basic_machine=mipstx39-unknown
+ ;;
+ tx39el)
+ basic_machine=mipstx39el-unknown
+ ;;
+ tower | tower-32)
+ basic_machine=m68k-ncr
+ ;;
+ udi29k)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ ultra3)
+ basic_machine=a29k-nyu
+ os=-sym1
+ ;;
+ v810 | necv810)
+ basic_machine=v810-nec
+ os=-none
+ ;;
+ vaxv)
+ basic_machine=vax-dec
+ os=-sysv
+ ;;
+ vms)
+ basic_machine=vax-dec
+ os=-vms
+ ;;
+ vpp*|vx|vx-*)
+ basic_machine=f301-fujitsu
+ ;;
+ vxworks960)
+ basic_machine=i960-wrs
+ os=-vxworks
+ ;;
+ vxworks68)
+ basic_machine=m68k-wrs
+ os=-vxworks
+ ;;
+ vxworks29k)
+ basic_machine=a29k-wrs
+ os=-vxworks
+ ;;
+ w65*)
+ basic_machine=w65-wdc
+ os=-none
+ ;;
+ w89k-*)
+ basic_machine=hppa1.1-winbond
+ os=-proelf
+ ;;
+ xmp)
+ basic_machine=xmp-cray
+ os=-unicos
+ ;;
+ xps | xps100)
+ basic_machine=xps100-honeywell
+ ;;
+ z8k-*-coff)
+ basic_machine=z8k-unknown
+ os=-sim
+ ;;
+ none)
+ basic_machine=none-none
+ os=-none
+ ;;
+
+# Here we handle the default manufacturer of certain CPU types. It is in
+# some cases the only manufacturer, in others, it is the most popular.
+ w89k)
+ basic_machine=hppa1.1-winbond
+ ;;
+ op50n)
+ basic_machine=hppa1.1-oki
+ ;;
+ op60c)
+ basic_machine=hppa1.1-oki
+ ;;
+ mips)
+ if [ x$os = x-linux-gnu ]; then
+ basic_machine=mips-unknown
+ else
+ basic_machine=mips-mips
+ fi
+ ;;
+ romp)
+ basic_machine=romp-ibm
+ ;;
+ rs6000)
+ basic_machine=rs6000-ibm
+ ;;
+ vax)
+ basic_machine=vax-dec
+ ;;
+ pdp11)
+ basic_machine=pdp11-dec
+ ;;
+ we32k)
+ basic_machine=we32k-att
+ ;;
+ sparc | sparcv9)
+ basic_machine=sparc-sun
+ ;;
+ cydra)
+ basic_machine=cydra-cydrome
+ ;;
+ orion)
+ basic_machine=orion-highlevel
+ ;;
+ orion105)
+ basic_machine=clipper-highlevel
+ ;;
+ mac | mpw | mac-mpw)
+ basic_machine=m68k-apple
+ ;;
+ pmac | pmac-mpw)
+ basic_machine=powerpc-apple
+ ;;
+ c4x*)
+ basic_machine=c4x-none
+ os=-coff
+ ;;
+ *)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $basic_machine in
+ *-digital*)
+ basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
+ ;;
+ *-commodore*)
+ basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
+ ;;
+ *)
+ ;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if [ x"$os" != x"" ]
+then
+case $os in
+ # First match some system type aliases
+ # that might get confused with valid system types.
+ # -solaris* is a basic system type, with this one exception.
+ -solaris1 | -solaris1.*)
+ os=`echo $os | sed -e 's|solaris1|sunos4|'`
+ ;;
+ -solaris)
+ os=-solaris2
+ ;;
+ -svr4*)
+ os=-sysv4
+ ;;
+ -unixware*)
+ os=-sysv4.2uw
+ ;;
+ -gnu/linux*)
+ os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
+ ;;
+ # First accept the basic system types.
+ # The portable systems comes first.
+ # Each alternative MUST END IN A *, to match a version number.
+ # -sysv* is not here because it comes later, after sysvr4.
+ -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+ | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\
+ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
+ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
+ | -aos* \
+ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+ | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \
+ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
+ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+ | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+ | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \
+ | -interix* | -uwin* | -rhapsody* | -openstep* | -oskit*)
+ # Remember, each alternative MUST END IN *, to match a version number.
+ ;;
+ -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
+ | -windows* | -osx | -abug | -netware* | -os9* | -beos* \
+ | -macos* | -mpw* | -magic* | -mon960* | -lnews*)
+ ;;
+ -mac*)
+ os=`echo $os | sed -e 's|mac|macos|'`
+ ;;
+ -linux*)
+ os=`echo $os | sed -e 's|linux|linux-gnu|'`
+ ;;
+ -sunos5*)
+ os=`echo $os | sed -e 's|sunos5|solaris2|'`
+ ;;
+ -sunos6*)
+ os=`echo $os | sed -e 's|sunos6|solaris3|'`
+ ;;
+ -osfrose*)
+ os=-osfrose
+ ;;
+ -osf*)
+ os=-osf
+ ;;
+ -utek*)
+ os=-bsd
+ ;;
+ -dynix*)
+ os=-bsd
+ ;;
+ -acis*)
+ os=-aos
+ ;;
+ -386bsd)
+ os=-bsd
+ ;;
+ -ctix* | -uts*)
+ os=-sysv
+ ;;
+ -ns2 )
+ os=-nextstep2
+ ;;
+ # Preserve the version number of sinix5.
+ -sinix5.*)
+ os=`echo $os | sed -e 's|sinix|sysv|'`
+ ;;
+ -sinix*)
+ os=-sysv4
+ ;;
+ -triton*)
+ os=-sysv3
+ ;;
+ -oss*)
+ os=-sysv3
+ ;;
+ -svr4)
+ os=-sysv4
+ ;;
+ -svr3)
+ os=-sysv3
+ ;;
+ -sysvr4)
+ os=-sysv4
+ ;;
+ # This must come after -sysvr4.
+ -sysv*)
+ ;;
+ -ose*)
+ os=-ose
+ ;;
+ -es1800*)
+ os=-ose
+ ;;
+ -xenix)
+ os=-xenix
+ ;;
+ -*mint | -*MiNT)
+ os=-mint
+ ;;
+ -none)
+ ;;
+ *)
+ # Get rid of the `-' at the beginning of $os.
+ os=`echo $os | sed 's/[^-]*-//'`
+ echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+else
+
+# Here we handle the default operating systems that come with various machines.
+# The value should be what the vendor currently ships out the door with their
+# machine or put another way, the most popular os provided with the machine.
+
+# Note that if you're going to try to match "-MANUFACTURER" here (say,
+# "-sun"), then you have to tell the case statement up towards the top
+# that MANUFACTURER isn't an operating system. Otherwise, code above
+# will signal an error saying that MANUFACTURER isn't an operating
+# system, and we'll never get to this point.
+
+case $basic_machine in
+ *-acorn)
+ os=-riscix1.2
+ ;;
+ arm*-corel)
+ os=-linux
+ ;;
+ arm*-semi)
+ os=-aout
+ ;;
+ pdp11-*)
+ os=-none
+ ;;
+ *-dec | vax-*)
+ os=-ultrix4.2
+ ;;
+ m68*-apollo)
+ os=-domain
+ ;;
+ i386-sun)
+ os=-sunos4.0.2
+ ;;
+ m68000-sun)
+ os=-sunos3
+ # This also exists in the configure program, but was not the
+ # default.
+ # os=-sunos4
+ ;;
+ m68*-cisco)
+ os=-aout
+ ;;
+ mips*-cisco)
+ os=-elf
+ ;;
+ mips*-*)
+ os=-elf
+ ;;
+ *-tti) # must be before sparc entry or we get the wrong os.
+ os=-sysv3
+ ;;
+ sparc-* | *-sun)
+ os=-sunos4.1.1
+ ;;
+ *-be)
+ os=-beos
+ ;;
+ *-ibm)
+ os=-aix
+ ;;
+ *-wec)
+ os=-proelf
+ ;;
+ *-winbond)
+ os=-proelf
+ ;;
+ *-oki)
+ os=-proelf
+ ;;
+ *-hp)
+ os=-hpux
+ ;;
+ *-hitachi)
+ os=-hiux
+ ;;
+ i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+ os=-sysv
+ ;;
+ *-cbm)
+ os=-amigaos
+ ;;
+ *-dg)
+ os=-dgux
+ ;;
+ *-dolphin)
+ os=-sysv3
+ ;;
+ m68k-ccur)
+ os=-rtu
+ ;;
+ m88k-omron*)
+ os=-luna
+ ;;
+ *-next )
+ os=-nextstep
+ ;;
+ *-sequent)
+ os=-ptx
+ ;;
+ *-crds)
+ os=-unos
+ ;;
+ *-ns)
+ os=-genix
+ ;;
+ i370-*)
+ os=-mvs
+ ;;
+ *-next)
+ os=-nextstep3
+ ;;
+ *-gould)
+ os=-sysv
+ ;;
+ *-highlevel)
+ os=-bsd
+ ;;
+ *-encore)
+ os=-bsd
+ ;;
+ *-sgi)
+ os=-irix
+ ;;
+ *-siemens)
+ os=-sysv4
+ ;;
+ *-masscomp)
+ os=-rtu
+ ;;
+ f301-fujitsu)
+ os=-uxpv
+ ;;
+ *-rom68k)
+ os=-coff
+ ;;
+ *-*bug)
+ os=-coff
+ ;;
+ *-apple)
+ os=-macos
+ ;;
+ *-atari*)
+ os=-mint
+ ;;
+ *)
+ os=-none
+ ;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer. We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+ *-unknown)
+ case $os in
+ -riscix*)
+ vendor=acorn
+ ;;
+ -sunos*)
+ vendor=sun
+ ;;
+ -aix*)
+ vendor=ibm
+ ;;
+ -beos*)
+ vendor=be
+ ;;
+ -hpux*)
+ vendor=hp
+ ;;
+ -mpeix*)
+ vendor=hp
+ ;;
+ -hiux*)
+ vendor=hitachi
+ ;;
+ -unos*)
+ vendor=crds
+ ;;
+ -dgux*)
+ vendor=dg
+ ;;
+ -luna*)
+ vendor=omron
+ ;;
+ -genix*)
+ vendor=ns
+ ;;
+ -mvs*)
+ vendor=ibm
+ ;;
+ -ptx*)
+ vendor=sequent
+ ;;
+ -vxsim* | -vxworks*)
+ vendor=wrs
+ ;;
+ -aux*)
+ vendor=apple
+ ;;
+ -hms*)
+ vendor=hitachi
+ ;;
+ -mpw* | -macos*)
+ vendor=apple
+ ;;
+ -*mint | -*MiNT)
+ vendor=atari
+ ;;
+ esac
+ basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+ ;;
+esac
+
+echo $basic_machine$os
--- /dev/null
+dnl Process this file with autoconf to produce a configure script.
+AC_REVISION($Id: configure.in,v 11.1 2000/12/05 21:23:43 cph Exp $)dnl
+AC_INIT(boot.c)
+AC_CONFIG_HEADER(config.h)
+
+dnl Substitution variables to be filled in below.
+AS_FLAGS=
+GC_HEAD_FILES=
+LIB_X11=
+M4_FLAGS=
+OPTIONAL_BASES=
+OPTIONAL_OBJECTS=
+OPTIONAL_SOURCES=
+STATIC_LIBS=
+STATIC_PREFIX=
+STATIC_SUFFIX=
+
+dnl Checks for programs.
+AC_PROG_CC
+AC_PROG_GCC_TRADITIONAL
+AC_PROG_INSTALL
+AC_PROG_LN_S
+AC_PROG_MAKE_SET
+if test "${GCC}" = "yes"; then
+ CFLAGS="${CFLAGS} -Wall"
+fi
+
+dnl Checks for libraries.
+AC_CHECK_LIB(dl, dlopen)
+AC_CHECK_LIB(m, exp)
+AC_CHECK_LIB(mhash, mhash_count,
+ [scheme_cv_lib_mhash=yes],
+ [scheme_cv_lib_mhash=no])
+if test "${scheme_cv_lib_mhash}" = "no"; then
+ AC_CHECK_LIB(md5, MD5Init,
+ [scheme_cv_lib_md5=yes],
+ [scheme_cv_lib_md5=no])
+fi
+AC_CHECK_LIB(blowfish, BF_set_key,
+ [scheme_cv_lib_blowfish=yes],
+ [scheme_cv_lib_blowfish=no])
+AC_CHECK_LIB(gdbm, gdbm_open,
+ [scheme_cv_lib_gdbm=yes],
+ [scheme_cv_lib_gdbm=no])
+AC_CHECK_LIB(ncurses, tparm,
+ [scheme_cv_lib_ncurses=yes],
+ [scheme_cv_lib_ncurses=no])
+if test "${scheme_cv_lib_ncurses}" = "yes"; then
+ AC_CHECK_LIB(ncurses, tparam,
+ [scheme_cv_lib_ncurses_has_tparam=yes],
+ [scheme_cv_lib_ncurses_has_tparam=no])
+fi
+AC_CHECK_LIB(curses, tparm,
+ [scheme_cv_lib_curses=yes],
+ [scheme_cv_lib_curses=no])
+AC_CHECK_LIB(termcap, tparam,
+ [scheme_cv_lib_termcap=yes],
+ [scheme_cv_lib_termcap=no])
+
+if test "${scheme_cv_lib_mhash}" = "yes"; then
+ AC_DEFINE(HAVE_LIBMHASH)
+ STATIC_LIBS="${STATIC_LIBS} -lmhash"
+fi
+if test "${scheme_cv_lib_md5}" = "yes"; then
+ AC_DEFINE(HAVE_LIBMD5)
+ STATIC_LIBS="${STATIC_LIBS} -lmd5"
+fi
+if test "${scheme_cv_lib_blowfish}" = "yes"; then
+ AC_DEFINE(HAVE_LIBBLOWFISH)
+ STATIC_LIBS="${STATIC_LIBS} -lblowfish"
+fi
+if test "${scheme_cv_lib_gdbm}" = "yes"; then
+ AC_DEFINE(HAVE_LIBGDBM)
+ STATIC_LIBS="${STATIC_LIBS} -lgdbm"
+fi
+if test "${scheme_cv_lib_ncurses}" = "yes"; then
+ AC_DEFINE(HAVE_LIBNCURSES)
+ STATIC_LIBS="${STATIC_LIBS} -lncurses"
+elif test "${scheme_cv_lib_curses}" = "yes"; then
+ AC_DEFINE(HAVE_LIBCURSES)
+ STATIC_LIBS="${STATIC_LIBS} -lcurses"
+elif test "${scheme_cv_lib_termcap}" = "yes"; then
+ AC_DEFINE(HAVE_LIBTERMCAP)
+ STATIC_LIBS="${STATIC_LIBS} -ltermcap"
+fi
+
+if test "${scheme_cv_lib_mhash}" = "yes"; then
+ OPTIONAL_BASES="${OPTIONAL_BASES} prmhash"
+fi
+if test "${scheme_cv_lib_md5}" = "yes"; then
+ OPTIONAL_BASES="${OPTIONAL_BASES} prmd5"
+fi
+if test "${scheme_cv_lib_blowfish}" = "yes"; then
+ OPTIONAL_BASES="${OPTIONAL_BASES} prbfish"
+fi
+if test "${scheme_cv_lib_gdbm}" = "yes"; then
+ OPTIONAL_BASES="${OPTIONAL_BASES} prgdbm"
+fi
+if test "${ac_cv_lib_dl_dlopen}" = "yes"; then
+ OPTIONAL_BASES="${OPTIONAL_BASES} pruxdld"
+fi
+if test "${scheme_cv_lib_ncurses}" = "yes"; then
+ if test "${scheme_cv_lib_ncurses_has_tparam}" = "no"; then
+ OPTIONAL_BASES="${OPTIONAL_BASES} terminfo"
+ fi
+elif test "${scheme_cv_lib_curses}" = "yes"; then
+ OPTIONAL_BASES="${OPTIONAL_BASES} terminfo"
+elif test "${scheme_cv_lib_termcap}" = "yes"; then
+ OPTIONAL_BASES="${OPTIONAL_BASES} tparam"
+else
+ OPTIONAL_BASES="${OPTIONAL_BASES} termcap tparam"
+fi
+
+dnl Checks for header files.
+AC_HEADER_DIRENT
+AC_HEADER_STDC
+AC_HEADER_SYS_WAIT
+AC_HEADER_TIME
+AC_CHECK_HEADERS(bsdtty.h fcntl.h limits.h malloc.h sgtty.h stropts.h time.h)
+AC_CHECK_HEADERS(sys/file.h sys/ioctl.h sys/mount.h sys/param.h sys/poll.h)
+AC_CHECK_HEADERS(sys/ptyio.h sys/socket.h sys/time.h sys/un.h sys/vfs.h)
+AC_CHECK_HEADERS(termio.h termios.h unistd.h utime.h)
+
+dnl Checks for typedefs
+AC_TYPE_MODE_T
+AC_TYPE_OFF_T
+AC_TYPE_PID_T
+AC_TYPE_SIGNAL
+AC_TYPE_SIZE_T
+AC_TYPE_UID_T
+AC_CHECK_TYPE(nlink_t, short)
+
+AC_MSG_CHECKING([for clock_t])
+AC_TRY_COMPILE([
+#ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# ifdef HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif],
+ [clock_t x;],
+ [scheme_cv_type_clock_t=yes],
+ [scheme_cv_type_clock_t=no])
+AC_MSG_RESULT(${scheme_cv_type_clock_t})
+if test "${scheme_cv_type_clock_t}" = "no"; then
+ AC_DEFINE(clock_t, unsigned long)
+fi
+
+AC_MSG_CHECKING([for time_t])
+AC_TRY_COMPILE([
+#ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# ifdef HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif],
+ [time_t x;],
+ [scheme_cv_type_time_t=yes],
+ [scheme_cv_type_time_t=no])
+AC_MSG_RESULT(${scheme_cv_type_time_t})
+if test "${scheme_cv_type_time_t}" = "no"; then
+ AC_DEFINE(time_t, long)
+fi
+
+if test "${ac_cv_header_sys_socket_h}" = "yes"; then
+ AC_MSG_CHECKING([for socklen_t])
+ AC_TRY_COMPILE(
+ [#include <sys/socket.h>],
+ [socklen_t x;],
+ [scheme_cv_type_socklen_t=yes],
+ [scheme_cv_type_socklen_t=no])
+ AC_MSG_RESULT(${scheme_cv_type_socklen_t})
+ if test "${scheme_cv_type_socklen_t}" = "no"; then
+ AC_DEFINE(socklen_t, int)
+ fi
+fi
+
+AC_MSG_CHECKING([for cc_t])
+AC_TRY_COMPILE([
+#ifdef HAVE_TERMIOS_H
+# include <termios.h>
+#else
+# ifdef HAVE_TERMIO_H
+# include <termio.h>
+# endif
+#endif],
+ [cc_t x;],
+ [scheme_cv_type_cc_t=yes],
+ [scheme_cv_type_cc_t=no])
+AC_MSG_RESULT(${scheme_cv_type_cc_t})
+if test "${scheme_cv_type_cc_t}" = "no"; then
+ AC_DEFINE(cc_t, unsigned char)
+fi
+
+dnl Checks for structures.
+AC_STRUCT_TM
+AC_STRUCT_TIMEZONE
+
+AC_MSG_CHECKING([for tm_gmtoff in struct tm])
+AC_TRY_LINK(
+ [#include <time.h>],
+ [struct tm t; t.tm_gmtoff],
+ [scheme_cv_struct_tm_gmtoff=yes],
+ [scheme_cv_struct_tm_gmtoff=no])
+AC_MSG_RESULT(${scheme_cv_struct_tm_gmtoff})
+if test "${scheme_cv_struct_tm_gmtoff}" = "yes"; then
+ AC_DEFINE(HAVE_TM_GMTOFF)
+ AC_DEFINE(TM_GMTOFF, tm_gmtoff)
+else
+ AC_MSG_CHECKING([for __tm_gmtoff in struct tm])
+ AC_TRY_LINK(
+ [#include <time.h>],
+ [struct tm t; t.__tm_gmtoff],
+ [scheme_cv_struct___tm_gmtoff=yes],
+ [scheme_cv_struct___tm_gmtoff=no])
+ AC_MSG_RESULT(${scheme_cv_struct___tm_gmtoff})
+ if test "${scheme_cv_struct___tm_gmtoff}" = "yes"; then
+ AC_DEFINE(HAVE_TM_GMTOFF)
+ AC_DEFINE(TM_GMTOFF, __tm_gmtoff)
+ else
+ AC_MSG_CHECKING([for timezone])
+ AC_TRY_LINK([
+#ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# ifdef HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif],
+ [timezone;],
+ [scheme_cv_var_timezone=yes],
+ [scheme_cv_var_timezone=no])
+ AC_MSG_RESULT(${scheme_cv_var_timezone})
+ if test "${scheme_cv_var_timezone}" = "yes"; then
+ AC_DEFINE(HAVE_TIMEZONE)
+ AC_DEFINE(TIMEZONE, timezone)
+ else
+ AC_MSG_CHECKING([for __timezone])
+ AC_TRY_LINK([
+#ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# ifdef HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif],
+ [__timezone;],
+ [scheme_cv_var___timezone=yes],
+ [scheme_cv_var___timezone=no])
+ AC_MSG_RESULT(${scheme_cv_var___timezone})
+ if test "${scheme_cv_var___timezone}" = "yes"; then
+ AC_DEFINE(HAVE_TIMEZONE)
+ AC_DEFINE(TIMEZONE, __timezone)
+ fi
+ fi
+ fi
+fi
+
+if test "${ac_cv_header_bsdtty_h}" = "yes"; then
+ AC_MSG_CHECKING([for struct ltchars])
+ AC_TRY_COMPILE(
+ [#include <bsdtty.h>],
+ [struct ltchars x;],
+ [scheme_cv_struct_ltchars=yes],
+ [scheme_cv_struct_ltchars=no])
+ AC_MSG_RESULT(${scheme_cv_struct_ltchars})
+ if test "${scheme_cv_struct_ltchars}" = "yes"; then
+ AC_DEFINE(HAVE_STRUCT_LTCHARS)
+ fi
+fi
+
+AC_MSG_CHECKING([for hostent h_addr_list])
+AC_TRY_COMPILE(
+ [#include <netdb.h>],
+ [struct hostent x; x.h_addr_list;],
+ [scheme_cv_struct_hostent_h_addr_list=yes],
+ [scheme_cv_struct_hostent_h_addr_list=no])
+AC_MSG_RESULT(${scheme_cv_struct_hostent_h_addr_list})
+if test "${scheme_cv_struct_hostent_h_addr_list}" = "yes"; then
+ AC_DEFINE(HAVE_HOSTENT_H_ADDR_LIST)
+fi
+
+AC_MSG_CHECKING([for struct sigcontext])
+AC_TRY_COMPILE(
+ [#include <signal.h>],
+ [struct sigcontext x;],
+ [scheme_cv_struct_sigcontext=yes],
+ [scheme_cv_struct_sigcontext=no])
+AC_MSG_RESULT(${scheme_cv_struct_sigcontext})
+if test "${scheme_cv_struct_sigcontext}" = "yes"; then
+ AC_DEFINE(HAVE_STRUCT_SIGCONTEXT)
+fi
+
+dnl Checks for compiler characteristics.
+AC_C_BIGENDIAN
+AC_C_CHAR_UNSIGNED
+AC_C_CONST
+AC_CHECK_SIZEOF(unsigned long)
+
+dnl Checks for C library functions.
+AC_FUNC_GETPGRP
+AC_FUNC_MEMCMP
+AC_FUNC_MMAP
+AC_FUNC_SETPGRP
+AC_FUNC_SETVBUF_REVERSED
+AC_FUNC_UTIME_NULL
+AC_FUNC_VFORK
+AC_FUNC_VPRINTF
+AC_FUNC_WAIT3
+AC_CHECK_FUNCS(ctermid)
+AC_CHECK_FUNCS(dup2)
+AC_CHECK_FUNCS(fcntl floor fpathconf frexp ftruncate)
+AC_CHECK_FUNCS(getcwd gethostbyname gethostname getlogin getpgrp)
+AC_CHECK_FUNCS(gettimeofday getwd grantpt)
+AC_CHECK_FUNCS(kill)
+AC_CHECK_FUNCS(lockf)
+AC_CHECK_FUNCS(memcpy mkdir mktime modf)
+AC_CHECK_FUNCS(nice)
+AC_CHECK_FUNCS(poll prealloc)
+AC_CHECK_FUNCS(rename rmdir)
+AC_CHECK_FUNCS(select setitimer setpgrp setpgrp2 shmat sigaction)
+AC_CHECK_FUNCS(sighold socket statfs strchr strstr strtol strtoul)
+AC_CHECK_FUNCS(symlink sysconf)
+AC_CHECK_FUNCS(times truncate)
+AC_CHECK_FUNCS(uname utime)
+AC_CHECK_FUNCS(waitpid)
+
+if test "${ac_cv_type_signal}" = "void"; then
+ AC_DEFINE(VOID_SIGNAL_HANDLERS)
+fi
+
+dnl Checks for system characteristics.
+AC_CANONICAL_HOST
+AC_PATH_XTRA
+AC_SYS_LONG_FILE_NAMES
+AC_SYS_RESTARTABLE_SYSCALLS
+
+dnl Add support for X if present.
+if test "${no_x}" = "yes"; then
+ LIB_X11=
+else
+ LIB_X11=-lX11
+ OPTIONAL_BASES="${OPTIONAL_BASES} x11base x11term x11graph x11color"
+fi
+
+dnl Add OS-dependent customizations.
+case "$host_os" in
+linux-gnu)
+ STATIC_PREFIX="-Xlinker -Bstatic"
+ STATIC_SUFFIX="-Xlinker -Bdynamic"
+ AC_MSG_CHECKING([for ELF binaries])
+ AC_TRY_RUN(
+[int
+main ()
+{
+#ifdef __ELF__
+return 0;
+#endif
+return 1;
+}],
+ [scheme_cv_linux_elf=yes],
+ [scheme_cv_linux_elf=no])
+ AC_MSG_RESULT(${scheme_cv_linux_elf})
+ if test "${scheme_cv_linux_elf}" = "yes"; then
+ M4_FLAGS="${M4_FLAGS} -P LINUX_ELF,1"
+ fi
+ if test "${GCC}" = "yes"; then
+ AC_MSG_CHECKING([for GCC version >= 2.95])
+ AC_TRY_RUN(
+[int
+main ()
+{
+#if ((__GNUC__ > 2) || ((__GNUC__ == 2) && (__GNUC_MINOR__ >= 95)))
+return 0;
+#endif
+return 1;
+}],
+ [scheme_cv_gcc3=yes],
+ [scheme_cv_gcc3=no])
+ AC_MSG_RESULT(${scheme_cv_gcc3})
+ if test "${scheme_cv_gcc3}" = "yes"; then
+ M4_FLAGS="${M4_FLAGS} -P CALLEE_POPS_STRUCT_RETURN,1"
+ fi
+ fi
+ ;;
+freebsdelf*)
+ M4_FLAGS="${M4_FLAGS} -P SUPPRESS_LEADING_UNDERSCORE,1"
+ ;;
+esac
+
+dnl Add architecture-dependent customizations.
+dnl This is mostly support for native-code compilation.
+scheme_compiler_key=
+OPTIONAL_BASES="${OPTIONAL_BASES} cmpint"
+GC_HEAD_FILES="gccode.h cmpgc.h"
+case "$host_cpu" in
+alpha*)
+ scheme_compiler_key=alpha
+ ;;
+hppa*)
+ scheme_compiler_key=hppa
+ GC_HEAD_FILES="${GC_HEAD_FILES} hppacach.h"
+ ;;
+i?86)
+ scheme_compiler_key=i386
+ ;;
+m68k|m680?0)
+ scheme_compiler_key=mc68k
+ ;;
+mips*)
+ scheme_compiler_key=mips
+ ;;
+vax)
+ scheme_compiler_key=vax
+ ;;
+esac
+if test "${scheme_compiler_key}" != ""; then
+ AC_DEFINE(HAS_COMPILER_SUPPORT)
+ ${ac_cv_prog_LN_S} cmpauxmd/${scheme_compiler_key}.m4 cmpauxmd.m4
+ ${ac_cv_prog_LN_S} cmpintmd/${scheme_compiler_key}.h cmpintmd.h
+ OPTIONAL_SOURCES="${OPTIONAL_SOURCES} cmpauxmd.m4"
+ OPTIONAL_OBJECTS="${OPTIONAL_OBJECTS} cmpauxmd.o"
+ GC_HEAD_FILES="${GC_HEAD_FILES} cmpintmd.h"
+fi
+
+for base in ${OPTIONAL_BASES}; do
+ OPTIONAL_SOURCES="${OPTIONAL_SOURCES} ${base}.c"
+ OPTIONAL_OBJECTS="${OPTIONAL_OBJECTS} ${base}.o"
+done
+
+AC_SUBST(AS_FLAGS)
+AC_SUBST(GC_HEAD_FILES)
+AC_SUBST(LIB_X11)
+AC_SUBST(M4_FLAGS)
+AC_SUBST(OPTIONAL_OBJECTS)
+AC_SUBST(OPTIONAL_SOURCES)
+AC_SUBST(STATIC_LIBS)
+AC_SUBST(STATIC_PREFIX)
+AC_SUBST(STATIC_SUFFIX)
+
+AC_OUTPUT(Makefile)
--- /dev/null
+/* -*-C-*-
+
+$Id: confshared.h,v 11.1 2000/12/05 21:23:43 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*/
+
+/* Shared part of "config.h". */
+
+#ifndef SCM_CONFSHARED_H
+#define SCM_CONFSHARED_H
+
+#include "ansidecl.h"
+
+/* To enable the STEPPER. Incompatible with futures. */
+#define COMPILE_STEPPER
+
+/* Some configuration consistency testing */
+
+#ifdef COMPILE_STEPPER
+# ifdef COMPILE_FUTURES
+# include "Error: The stepper doesn't work with futures."
+# endif
+# ifdef USE_STACKLETS
+# include "Error: The stepper doesn't work with stacklets."
+# endif
+#endif
+
+/* For use in the C pre-processor, not in code! */
+#define FALSE 0
+#define TRUE 1
+
+/* These C type definitions are needed by everybody.
+ They should not be here, but it is unavoidable. */
+typedef char Boolean;
+#define true ((Boolean) TRUE)
+#define false ((Boolean) FALSE)
+
+/* This is the Scheme object type.
+ The various fields are defined in "object.h". */
+typedef unsigned long SCHEME_OBJECT;
+#define OBJECT_LENGTH (CHAR_BIT * SIZEOF_UNSIGNED_LONG)
+\f
+/* Operating System / Machine dependencies:
+
+ For each implementation, be sure to specify FASL_INTERNAL_FORMAT.
+ Make sure that there is an appropriate FASL_<machine name>.
+ If there isn't, add one to the list below.
+
+ If you do not know the values of the parameters specified below,
+ try compiling and running the Wsize program ("make Wsize" if on a
+ unix variant). It may not run, but if it does, it will probably
+ compute the correct information.
+
+ Note that the C type void is used in the sources. If your version
+ of C does not have this type, you should bypass it. This can be
+ done by inserting the preprocessor command '#define void' in this
+ file, under the heading for your kind of machine.
+
+ These parameters MUST be specified (and are computed by Wsize):
+
+ CHAR_BIT is the size of a character in bits.
+
+ FLOATING_ALIGNMENT should be defined ONLY if the system requires
+ floating point numbers (double) to be aligned more strictly than
+ SCHEME_OBJECTs (unsigned long). The value must be a mask of the
+ low order bits which are required to be zero for the storage
+ address. For example, a value of 0x7 requires octabyte alignment
+ on a machine where addresses are specified in bytes. The alignment
+ must be an integral multiple of the length of a long.
+
+ Other flags (the safe option is NOT to define them, which will
+ sacrifice speed for safety):
+
+ HEAP_IN_LOW_MEMORY should be defined if malloc returns the lowest
+ available memory and thus all addresses will fit in the datum portion
+ of a Scheme object. The datum portion of a Scheme object is 8 bits
+ less than the length of a C long. */
+\f
+/* Possible values for FASL_INTERNAL_FORMAT. For the most part this
+ means the processor type, so for example there are several aliases
+ for 68000 family processors. This scheme allows sharing of
+ compiled code on machines with the same processor type. Probably
+ we will have to create a more powerful method of identifying FASL
+ files when we introduce new differences, such as whether or not a
+ 68881 coprocessor is installed. */
+
+#define FASL_UNKNOWN 0
+#define FASL_PDP10 1
+#define FASL_VAX 2
+#define FASL_68020 3
+#define FASL_68000 4
+#define FASL_HP_9000_500 5
+#define FASL_IA32 6
+#define FASL_BFLY 7
+#define FASL_CYBER 8
+#define FASL_CELERITY 9
+#define FASL_HP_SPECTRUM 10
+#define FASL_UMAX 11
+#define FASL_PYR 12
+#define FASL_ALLIANT 13
+#define FASL_SPARC 14
+#define FASL_MIPS 15
+#define FASL_APOLLO_68K 16
+#define FASL_APOLLO_PRISM 17
+#define FASL_ALPHA 18
+#define FASL_RS6000 19
+\f
+#ifdef vax
+
+/* Amazingly unix and vms agree on all these */
+
+#define MACHINE_TYPE "vax"
+#define FASL_INTERNAL_FORMAT FASL_VAX
+#define TYPE_CODE_LENGTH 6
+#define HEAP_IN_LOW_MEMORY
+
+/* Not on these, however */
+
+#ifdef vms
+
+#define VMS_VERSION 4
+#define VMS_SUBVERSION 5
+
+/* If your C runtime library already defines the `tbuffer' datatype,
+ then define this symbol. */
+/* #define HAVE_TBUFFER */
+
+/* Name conflict in VMS with system variable */
+#define Free Free_Register
+
+#if (VMS_VERSION < 4)
+ /* Pre version 4 VMS has no void type. */
+# define void
+#endif
+
+/* This eliminates a spurious warning from the C compiler. */
+#define main_type
+
+/* exit(0) produces horrible message on VMS */
+#define NORMAL_EXIT 1
+
+#define EXIT_SCHEME_DECLARATIONS static jmp_buf exit_scheme_jmp_buf
+
+#define INIT_EXIT_SCHEME() \
+{ \
+ int which_way = (setjmp (exit_scheme_jmp_buf)); \
+ if (which_way == NORMAL_EXIT) \
+ return; \
+}
+
+#define EXIT_SCHEME(value) \
+{ \
+ if (value != 0) \
+ exit (value); \
+ longjmp (exit_scheme_jmp_buf, NORMAL_EXIT); \
+}
+
+#else /* not vms */
+
+/* Vax Unix C compiler bug */
+#define HAVE_DOUBLE_TO_LONG_BUG
+
+#endif /* not vms */
+#endif /* vax */
+\f
+#if defined(hp9000s800) || defined(__hp9000s800)
+#if defined(hp9000s700) || defined(__hp9000s700)
+#define MACHINE_TYPE "hp9000s700"
+#else
+#define MACHINE_TYPE "hp9000s800"
+#endif
+#define FASL_INTERNAL_FORMAT FASL_HP_SPECTRUM
+#define TYPE_CODE_LENGTH 6
+#define FLOATING_ALIGNMENT 0x7
+
+/* Heap resides in data space, pointed at by space register 5.
+ Short pointers must have their high two bits set to 01 so that
+ it is interpreted as space register 5, 2nd quadrant.
+
+ This is kludged by the definitions below, and is still considered
+ HEAP_IN_LOW_MEMORY. */
+
+#define HEAP_IN_LOW_MEMORY
+
+/* data segment bits and mask for all bits */
+
+#define HPPA_QUAD_BIT 0x40000000
+#define HPPA_QUAD_MASK 0xC0000000
+
+#define DATUM_TO_ADDRESS(datum) \
+ ((SCHEME_OBJECT *) (((unsigned long) (datum)) | HPPA_QUAD_BIT))
+
+#define ADDRESS_TO_DATUM(address) \
+ ((SCHEME_OBJECT) (((unsigned long) (address)) & (~(HPPA_QUAD_MASK))))
+
+#if (SCHEME_VERSION > 11)
+
+/* SHARP_F is a magic value:
+ Typecode TC_CONSTANT, high datum bits #b100, low datum bits are the top
+ TYPE_CODE_LENGTH bits of HPPA_QUAD_BIT
+
+ SHARP_F is stored in gr5 for access by compiled code. This allows
+ us to generate #F and test against #F quickly, and also to use gr5
+ for compiled OBJECT->ADDRESS operations. If we ever go to 5bit
+ typecodes we will be able to dispense with this overloading.
+
+ See also cmpauxmd/hppa.m4. */
+
+#define SHARP_F 0x22000010
+#endif /* (SCHEME_VERSION > 11) */
+
+#endif /* hp9000s800 */
+
+#if defined(hp9000s300) || defined(__hp9000s300)
+#if defined(hp9000s400) || defined(__hp9000s400)
+#define MACHINE_TYPE "hp9000s400"
+#else
+#define MACHINE_TYPE "hp9000s300"
+#endif
+#ifdef MC68010
+#define FASL_INTERNAL_FORMAT FASL_68000
+#else
+#define FASL_INTERNAL_FORMAT FASL_68020
+#endif
+#define HEAP_IN_LOW_MEMORY
+#define TYPE_CODE_LENGTH 6
+
+#endif /* hp9000s300 */
+
+#ifdef hp9000s500
+#define MACHINE_TYPE "hp9000s500"
+#define FASL_INTERNAL_FORMAT FASL_HP_9000_500
+
+/* An unfortunate fact of life on this machine:
+ the C heap is in high memory thus HEAP_IN_LOW_MEMORY is not
+ defined and the whole thing runs slowly. */
+
+/* C Compiler bug when constant folding and anchor pointing */
+#define And2(x, y) ((x) ? (y) : false)
+#define And3(x, y, z) ((x) ? ((y) ? (z) : false) : false)
+#define Or2(x, y) ((x) ? true : (y))
+#define Or3(x, y, z) ((x) ? true : ((y) ? true : (z)))
+
+#endif /* hp9000s500 */
+\f
+#ifdef sparc
+# define MACHINE_TYPE "sun4"
+# define FASL_INTERNAL_FORMAT FASL_SPARC
+# define FLOATING_ALIGNMENT 0x7
+# define HEAP_IN_LOW_MEMORY
+# define HAVE_DOUBLE_TO_LONG_BUG
+#endif
+
+#ifdef sun3
+# define MACHINE_TYPE "sun3"
+# define FASL_INTERNAL_FORMAT FASL_68020
+# define TYPE_CODE_LENGTH 6
+# define HEAP_IN_LOW_MEMORY
+# define HAVE_DOUBLE_TO_LONG_BUG
+#endif
+
+#ifdef sun2
+# define MACHINE_TYPE "sun2"
+# define FASL_INTERNAL_FORMAT FASL_68000
+# define HEAP_IN_LOW_MEMORY
+# define HAVE_DOUBLE_TO_LONG_BUG
+#endif
+
+#ifdef NeXT
+# define MACHINE_TYPE "next"
+# define FASL_INTERNAL_FORMAT FASL_68020
+# define TYPE_CODE_LENGTH 6
+# define HEAP_IN_LOW_MEMORY
+#endif
+\f
+#if defined(_M_IX86) || defined(__i386__) || defined(__i386) || defined(i386)
+# define __IA32__
+#endif
+
+#ifdef __IA32__
+
+#define FASL_INTERNAL_FORMAT FASL_IA32
+#define HEAP_IN_LOW_MEMORY
+#define TYPE_CODE_LENGTH 6
+
+#ifdef sequent
+# define MACHINE_TYPE "sequent386"
+#endif
+
+#ifdef sun
+# define MACHINE_TYPE "sun386i"
+#endif
+
+#ifndef MACHINE_TYPE
+# define MACHINE_TYPE "IA-32"
+#endif
+
+#ifdef __linux__
+ extern void * linux_heap_malloc (unsigned long);
+# define HEAP_MALLOC linux_heap_malloc
+# define HEAP_FREE(address)
+#endif
+
+#ifdef __FreeBSD__
+ extern void * freebsd_heap_malloc (unsigned long);
+# define HEAP_MALLOC freebsd_heap_malloc
+# define HEAP_FREE(address)
+#endif
+
+#endif /* __IA32__ */
+\f
+#ifdef mips
+
+#define MACHINE_TYPE "mips"
+#define FASL_INTERNAL_FORMAT FASL_MIPS
+#define TYPE_CODE_LENGTH 6
+#define FLOATING_ALIGNMENT 0x7
+
+#if defined(_IRIX6) && defined(HAS_COMPILER_SUPPORT) && !defined(NATIVE_CODE_IS_C)
+ extern void * irix_heap_malloc (long);
+# define HEAP_MALLOC irix_heap_malloc
+#endif
+
+/* Heap resides in data space which begins at 0x10000000. This is
+ kludged by the definitions below, and is still considered
+ HEAP_IN_LOW_MEMORY. */
+
+#define HEAP_IN_LOW_MEMORY
+#define MIPS_DATA_BIT 0x10000000
+
+#define DATUM_TO_ADDRESS(datum) \
+ ((SCHEME_OBJECT *) (((unsigned long) (datum)) | MIPS_DATA_BIT))
+
+#define ADDRESS_TO_DATUM(address) \
+ ((SCHEME_OBJECT) (((unsigned long) (address)) & (~(MIPS_DATA_BIT))))
+
+/* MIPS compiled binaries are large! */
+#ifdef HAS_COMPILER_SUPPORT
+
+#ifndef DEFAULT_SMALL_CONSTANT
+#define DEFAULT_SMALL_CONSTANT 700
+#endif
+
+#ifndef DEFAULT_LARGE_CONSTANT
+#define DEFAULT_LARGE_CONSTANT 1500
+#endif
+
+#endif /* HAS_COMPILER_SUPPORT */
+
+#endif /* mips */
+\f
+#ifdef __alpha
+#define MACHINE_TYPE "Alpha"
+#define FASL_INTERNAL_FORMAT FASL_ALPHA
+#define TYPE_CODE_LENGTH 8
+
+/* The ASCII character set is used. */
+#define HEAP_IN_LOW_MEMORY 1
+
+/* Flonums have no special alignment constraints. */
+#define FLONUM_MANTISSA_BITS 53
+#define FLONUM_EXPT_SIZE 10
+#define MAX_FLONUM_EXPONENT 1023
+/* Floating point representation uses hidden bit. */
+
+#if defined(HAS_COMPILER_SUPPORT) && !defined(NATIVE_CODE_IS_C)
+ extern void * alpha_heap_malloc (long);
+# define HEAP_MALLOC alpha_heap_malloc
+#endif
+
+#endif /* __alpha */
+\f
+#ifdef __OS2__
+
+#define PREALLOCATE_HEAP_MEMORY() \
+{ \
+ extern void OS2_alloc_heap (void); \
+ OS2_alloc_heap (); \
+}
+
+extern void * OS2_commit_heap (unsigned long);
+#define HEAP_MALLOC OS2_commit_heap
+#define HEAP_FREE(address)
+
+#define EXIT_SCHEME_DECLARATIONS extern void OS2_exit_scheme (int)
+#define EXIT_SCHEME OS2_exit_scheme
+
+extern void OS2_stack_reset (void);
+#define STACK_RESET OS2_stack_reset
+
+extern int OS2_stack_overflowed_p (void);
+#define STACK_OVERFLOWED_P OS2_stack_overflowed_p
+
+#endif /* __OS2__ */
+
+#ifdef __WIN32__
+
+extern void EXFUN (win32_stack_reset, (void));
+#define STACK_RESET win32_stack_reset
+
+#define HEAP_MALLOC(size) (WIN32_ALLOCATE_HEAP ((size), (&scheme_heap_handle)))
+#define HEAP_FREE(base) \
+ WIN32_RELEASE_HEAP (((char *) (base)), scheme_heap_handle)
+
+/* We must not define `main' as that causes conflicts when compiling
+ this code with the Watcom C compiler. */
+#define main_name scheme_main
+
+#endif /* __WIN32__ */
+\f
+/* These (pdp10, nu) haven't worked in a while.
+ Should be upgraded or flushed some day. */
+
+#ifdef pdp10
+#define MACHINE_TYPE "pdp10"
+#define FASL_INTERNAL_FORMAT FASL_PDP10
+#define HEAP_IN_LOW_MEMORY
+#define CHAR_BIT 36 / * Ugh! Supposedly fixed in newer Cs * /
+#define UNSIGNED_SHIFT_BUG
+#endif
+
+#ifdef nu
+#define MACHINE_TYPE "nu"
+#define FASL_INTERNAL_FORMAT FASL_68000
+#define HEAP_IN_LOW_MEMORY
+#define UNSIGNED_SHIFT_BUG
+#endif
+
+/* These are pretty old too, but more recent versions have run. */
+
+#ifdef butterfly
+#define MACHINE_TYPE "butterfly"
+#define FASL_INTERNAL_FORMAT FASL_BFLY
+#define HEAP_IN_LOW_MEMORY
+#include <public.h>
+#endif
+
+#ifdef cyber180
+#define MACHINE_TYPE "cyber180"
+#define FASL_INTERNAL_FORMAT FASL_CYBER
+#define HEAP_IN_LOW_MEMORY
+#define UNSIGNED_SHIFT_BUG
+/* The Cyber180 C compiler manifests a bug in hairy conditional expressions */
+#define Conditional_Bug
+#endif
+
+#ifdef celerity
+#define MACHINE_TYPE "celerity"
+#define FASL_INTERNAL_FORMAT FASL_CELERITY
+#define HEAP_IN_LOW_MEMORY
+#endif
+
+#ifdef umax
+#define MACHINE_TYPE "umax"
+#define FASL_INTERNAL_FORMAT FASL_UMAX
+#define HEAP_IN_LOW_MEMORY
+#endif
+
+#ifdef pyr
+#define MACHINE_TYPE "pyramid"
+#define FASL_INTERNAL_FORMAT FASL_PYR
+#define HEAP_IN_LOW_MEMORY
+#endif
+
+#ifdef alliant
+#define MACHINE_TYPE "alliant"
+#define FASL_INTERNAL_FORMAT FASL_ALLIANT
+#define HEAP_IN_LOW_MEMORY
+#endif
+
+#ifdef apollo
+#if _ISP__M68K
+#define MACHINE_TYPE "Apollo 68k"
+#define FASL_INTERNAL_FORMAT FASL_APOLLO_68K
+#define TYPE_CODE_LENGTH 6
+#else
+#define MACHINE_TYPE "Apollo Prism"
+#define FASL_INTERNAL_FORMAT FASL_APOLLO_PRISM
+#endif
+#define HEAP_IN_LOW_MEMORY
+#endif
+
+#ifdef _IBMR2
+#define MACHINE_TYPE "IBM RS6000"
+#define FASL_INTERNAL_FORMAT FASL_RS6000
+/* Heap is not in Low Memory. */
+#define FLONUM_MANTISSA_BITS 53
+#define FLONUM_EXPT_SIZE 10
+#define MAX_FLONUM_EXPONENT 1023
+#endif
+\f
+#ifdef NATIVE_CODE_IS_C
+# ifndef HAS_COMPILER_SUPPORT
+# define HAS_COMPILER_SUPPORT
+# endif
+# ifndef TYPE_CODE_LENGTH
+# define TYPE_CODE_LENGTH 6
+# endif
+#endif
+
+/* Make sure that some definition applies. If this error occurs, and
+ the parameters of the configuration are unknown, try the Wsize
+ program. */
+#ifndef MACHINE_TYPE
+# include "Error: confshared.h: Unknown configuration."
+#endif
+
+/* Virtually all machines have 8-bit characters these days, so don't
+ explicitly specify this value unless it is different. */
+#ifndef CHAR_BIT
+# define CHAR_BIT 8
+#endif
+
+#ifndef TYPE_CODE_LENGTH
+# define TYPE_CODE_LENGTH 8
+#endif
+
+/* The GNU C compiler does not have any of these bugs. */
+#ifdef __GNUC__
+# undef HAVE_DOUBLE_TO_LONG_BUG
+# undef UNSIGNED_SHIFT_BUG
+# undef Conditional_Bug
+#endif
+
+#endif /* SCM_CONFSHARED_H */
/* -*-C-*-
-$Id: const.h,v 9.45 1999/01/02 06:06:43 cph Exp $
+$Id: const.h,v 9.46 2000/12/05 21:23:43 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#define STACK_FRAME_HEADER 1
/* Precomputed typed pointers */
-#ifdef b32 /* 32 bit word */
-
-#if (TYPE_CODE_LENGTH == 8)
-#define SHARP_F 0x00000000
-#define SHARP_T 0x08000000
-#define UNSPECIFIC 0x08000001
-#define FIXNUM_ZERO 0x1A000000
-#define BROKEN_HEART_ZERO 0x22000000
-#endif /* (TYPE_CODE_LENGTH == 8) */
-
-#if (TYPE_CODE_LENGTH == 6)
-#define SHARP_F 0x00000000
-#define SHARP_T 0x20000000
-#define UNSPECIFIC 0x20000001
-#define FIXNUM_ZERO 0x68000000
-#define BROKEN_HEART_ZERO 0x88000000
-#endif /* (TYPE_CODE_LENGTH == 6) */
-
-#endif /* b32 */
+#if (SIZEOF_UNSIGNED_LONG == 4) /* 32 bit word */
+# if (TYPE_CODE_LENGTH == 8)
+# define SHARP_F 0x00000000
+# define SHARP_T 0x08000000
+# define UNSPECIFIC 0x08000001
+# define FIXNUM_ZERO 0x1A000000
+# define BROKEN_HEART_ZERO 0x22000000
+# endif
+# if (TYPE_CODE_LENGTH == 6)
+# define SHARP_F 0x00000000
+# define SHARP_T 0x20000000
+# define UNSPECIFIC 0x20000001
+# define FIXNUM_ZERO 0x68000000
+# define BROKEN_HEART_ZERO 0x88000000
+# endif
+#endif
#ifndef SHARP_F /* Safe version */
-#define SHARP_F MAKE_OBJECT (TC_NULL, 0)
-#define SHARP_T MAKE_OBJECT (TC_CONSTANT, 0)
-#define UNSPECIFIC MAKE_OBJECT (TC_CONSTANT, 1)
-#define FIXNUM_ZERO MAKE_OBJECT (TC_FIXNUM, 0)
-#define BROKEN_HEART_ZERO MAKE_OBJECT (TC_BROKEN_HEART, 0)
+# define SHARP_F MAKE_OBJECT (TC_NULL, 0)
+# define SHARP_T MAKE_OBJECT (TC_CONSTANT, 0)
+# define UNSPECIFIC MAKE_OBJECT (TC_CONSTANT, 1)
+# define FIXNUM_ZERO MAKE_OBJECT (TC_FIXNUM, 0)
+# define BROKEN_HEART_ZERO MAKE_OBJECT (TC_BROKEN_HEART, 0)
#endif /* SHARP_F */
#define EMPTY_LIST SHARP_F
/* -*-C-*-
-$Id: debug.c,v 9.50 1999/01/02 06:11:34 cph Exp $
+$Id: debug.c,v 9.51 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
represent named structures, and most named structures don't want to
be printed out explicitly. */
-static void
-DEFUN (print_vector, (vector), SCHEME_OBJECT vector)
+void
+DEFUN (Print_Vector, (vector), SCHEME_OBJECT vector)
{
print_objects
((MEMORY_LOC (vector, 1)), (OBJECT_DATUM (VECTOR_LENGTH (vector))));
- return;
}
\f
static void
/* -*-C-*-
-$Id: default.h,v 9.43 1999/01/02 06:11:34 cph Exp $
+$Id: default.h,v 9.44 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#endif
#ifndef Fasdump_Free_Calc
-#define Fasdump_Free_Calc(NewFree, NewMemtop, ignored) do \
+#define Fasdump_Free_Calc(NewFree, NewMemtop) do \
{ \
NewFree = Unused_Heap_Bottom; \
NewMemTop = Unused_Heap_Top; \
/* -*-C-*-
-$Id: dmpwrld.c,v 9.39 1999/01/02 06:11:34 cph Exp $
+$Id: dmpwrld.c,v 9.40 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "scheme.h"
#include "prims.h"
-#ifndef _UNIX
+#ifndef __unix__
#include "Error: dumpworld.c does not work on non-unix machines."
#endif
#undef CANNOT_UNEXEC
#endif
-#if defined (hp9000s300)
+#if defined (hp9000s300) || defined (__hp9000s300)
#undef CANNOT_UNEXEC
#define ADJUST_EXEC_HEADER \
hdr.a_magic = ((ohdr.a_magic.file_type == OLDMAGIC.file_type) ? \
NEWMAGIC : ohdr.a_magic);
#endif
-#if defined (hp9000s800)
+#if defined (hp9000s800) || defined (__hp9000s800)
#undef CANNOT_UNEXEC
#endif
(((((unsigned) &etext) - 1) & ~SEGMENT_MASK) + (SEGMENT_MASK + 1))
#endif
-#if defined (_HPUX)
+#if defined (__HPUX__)
#define USG
#define HPUX
#endif
#define static
-#if defined (hp9000s800)
+#if defined (hp9000s800) || defined (__hp9000s800)
#include "unexhp9k800.c"
#else
#include "unexec.c"
/* -*-C-*-
-$Id: error.c,v 1.6 1999/01/03 05:34:02 cph Exp $
+$Id: error.c,v 1.7 2000/12/05 21:23:44 cph Exp $
-Copyright (C) 1990-1999 Massachusetts Institute of Technology
+Copyright (C) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
{
struct restart_record * record = current_restart_record;
Tptrvec_length length = 0;
- Tptrvec generalizations;
+ Tptrvec generalizations = 0;
Tptrvec result;
PTR * scan_result;
if (condition == 0)
/* -*-C-*-
-$Id: extern.h,v 9.56 1999/01/02 06:11:34 cph Exp $
+$Id: extern.h,v 9.57 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
/* The register block */
-#ifdef WINNT
+#ifdef __WIN32__
extern SCHEME_OBJECT *RegistersPtr;
#define Registers RegistersPtr
#else
/* -*-C-*-
-$Id: fasdump.c,v 9.63 1999/01/02 06:11:34 cph Exp $
+$Id: fasdump.c,v 9.64 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
\f
/* Some statics used freely in this file */
-static SCHEME_OBJECT *NewFree, *NewMemTop, *Fixup, *Orig_New_Free;
+static SCHEME_OBJECT *NewFree, *NewMemTop, *Fixup;
static Boolean compiled_code_present_p;
static CONST char * dump_file_name = ((char *) 0);
break;
default:
- GC_BAD_TYPE ("dumploop");
+ GC_BAD_TYPE ("dumploop", Temp);
/* Fall Through */
case TC_STACK_ENVIRONMENT:
DEFINE_PRIMITIVE ("PRIMITIVE-FASDUMP", Prim_prim_fasdump, 3, 3, 0)
{
- Tchannel channel;
+ Tchannel channel = NO_CHANNEL;
Boolean arg_string_p;
SCHEME_OBJECT Object, *New_Object, arg2, flag;
SCHEME_OBJECT * prim_table_start, * prim_table_end;
if (prim_table_start >= prim_table_end)
Primitive_GC (prim_table_start - Free);
- Fasdump_Free_Calc (NewFree, NewMemTop, Orig_New_Free);
+ Fasdump_Free_Calc (NewFree, NewMemTop);
Fixup = NewMemTop;
ALIGN_FLOAT (NewFree);
New_Object = NewFree;
/* -*-C-*-
-$Id: fasload.c,v 9.87 2000/01/18 05:08:09 cph Exp $
+$Id: fasload.c,v 9.88 2000/12/05 21:23:44 cph Exp $
Copyright (c) 1987-2000 Massachusetts Institute of Technology
#include "load.c"
-#ifdef _POSIX
-#include <string.h>
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <string.h>
#else
-extern int EXFUN (strlen, (const char *));
-extern char * EXFUN (strcpy, (char *, const char *));
-#endif
-#ifdef __STDC__
-#include <stdlib.h>
-#else
-extern char * EXFUN (malloc, (int));
+ extern char * EXFUN (malloc, (int));
+ extern int EXFUN (strlen, (const char *));
+ extern char * EXFUN (strcpy, (char *, const char *));
#endif
extern char * Error_Names [];
extern Boolean
EXFUN (install_c_code_table, (SCHEME_OBJECT *, long));
-
-#ifndef FLUSH_I_CACHE_REGION
-# define FLUSH_I_CACHE_REGION(addr, nwords) NOP()
-#endif
-
-#ifndef PUSH_D_CACHE_REGION
-# define PUSH_D_CACHE_REGION(addr, nwords) FLUSH_I_CACHE_REGION(addr, nwords)
-#endif
\f
static long failed_heap_length = -1;
Intern_Block (Orig_Constant, Constant_End);
}
+#ifdef PUSH_D_CACHE_REGION
if (dumped_interface_version != 0)
{
if (primitive_table != Orig_Heap)
if (Constant_End != Orig_Constant)
PUSH_D_CACHE_REGION (Orig_Constant, (Constant_End - Orig_Constant));
}
+#endif
FASLOAD_RELOCATE_HOOK (Orig_Heap, primitive_table,
Orig_Constant, Constant_End);
/* -*-C-*-
-$Id: findprim.c,v 9.53 2000/01/18 02:53:44 cph Exp $
+$Id: findprim.c,v 9.54 2000/12/05 21:23:44 cph Exp $
Copyright (c) 1987-2000 Massachusetts Institute of Technology
\f
/* Some utility imports and definitions. */
-#include "ansidecl.h"
+#include "config.h"
#include <stdio.h>
#define ASSUME_ANSIDECL
#include <ctype.h>
-#ifdef WINNT
-#include <string.h>
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <string.h>
#else
-extern int EXFUN (strcmp, (CONST char *, CONST char *));
-extern int EXFUN (strlen, (CONST char *));
+ extern void EXFUN (exit, (int));
+ extern PTR EXFUN (malloc, (int));
+ extern PTR EXFUN (realloc, (PTR, int));
+ extern void EXFUN (free, (PTR));
+ extern int EXFUN (strcmp, (CONST char *, CONST char *));
+ extern int EXFUN (strlen, (CONST char *));
#endif
typedef int boolean;
-#define TRUE 1
-#define FALSE 0
#ifdef vms
/* VMS version 3 has no void. */
#define pseudo_void int
#define pseudo_return return (0)
-extern void EXFUN (exit, (int));
-
-char *
-DEFUN (xmalloc, (length),
- int length)
+PTR
+DEFUN (xmalloc, (length), unsigned long length)
{
- char * result;
- extern PTR EXFUN (malloc, (int));
-
- result = ((char *) (malloc (length)));
- if (result == ((char *) 0))
+ PTR result = (malloc (length));
+ if (result == 0)
{
- fprintf (stderr, "malloc: unable to allocate %d bytes\n", length);
+ fprintf (stderr, "malloc: unable to allocate %ld bytes\n", length);
exit (1);
}
return (result);
}
-char *
-DEFUN (xrealloc, (ptr, length),
- char * ptr AND
- int length)
+PTR
+DEFUN (xrealloc, (ptr, length), PTR ptr AND unsigned long length)
{
- char * result;
- extern PTR EXFUN (realloc, (void *, int));
-
- result = ((char *) (realloc (ptr, length)));
- if (result == ((char *) 0))
+ PTR result = (realloc (ptr, length));
+ if (result == 0)
{
- fprintf (stderr, "realloc: unable to allocate %d bytes\n", length);
+ fprintf (stderr, "realloc: unable to allocate %ld bytes\n", length);
exit (1);
}
return (result);
}
-extern void EXFUN (free, (void *));
-
#define FIND_INDEX_LENGTH(index, size) \
{ \
char index_buffer [64]; \
char built_in_token [] = "Built_In_Primitive";
char external_token [] = "Define_Primitive";
-typedef pseudo_void (* TOKEN_PROCESSOR) ();
+typedef pseudo_void EXFUN ((* TOKEN_PROCESSOR), (void));
TOKEN_PROCESSOR token_processors [4];
char * the_kind;
void EXFUN (initialize_default, (void));
void EXFUN (initialize_external, (void));
void EXFUN (initialize_token_buffer, (void));
-void EXFUN (mergesort, (int low, int high,
- struct descriptor ** array,
- struct descriptor ** temp_array));
+static void EXFUN
+ (fp_mergesort, (int, int, struct descriptor **, struct descriptor **));
void EXFUN (print_procedure, (FILE * output,
struct descriptor * primitive_descriptor,
char * error_string));
char * arg AND
char * identification)
{
- int result;
-
- result = 0;
+ int result = 0;
if (((arg [0]) == '0') && ((arg [1]) == 'x'))
sscanf ((& (arg [2])), "%x", (& result));
else
sscanf ((& (arg [0])), "%d", (& result));
if (result < 0)
{
- fprintf (stderr, "%s: %s == %d\n", identification, result);
+ fprintf (stderr, "%s == %d\n", identification, result);
exit (1);
}
return (result);
(xmalloc (buffer_index * (sizeof (struct descriptor *)))));
for (count = 0; (count < buffer_index); count += 1)
(temp_buffer [count]) = (result_buffer [count]);
- mergesort (0, (buffer_index - 1), result_buffer, temp_buffer);
+ fp_mergesort (0, (buffer_index - 1), result_buffer, temp_buffer);
free (temp_buffer);
- return;
}
-void
-DEFUN (mergesort, (low, high, array, temp_array),
+static void
+DEFUN (fp_mergesort, (low, high, array, temp_array),
int low AND
register int high AND
register struct descriptor ** array AND
int high1;
int high2;
- dprintf ("mergesort: low = %d", low);
+ dprintf ("fp_mergesort: low = %d", low);
dprintf ("; high = %d", high);
if (high <= low)
dprintf ("; high1 = %d\n", high1);
- mergesort (low, high1, temp_array, array);
- mergesort (low2, high, temp_array, array);
+ fp_mergesort (low, high1, temp_array, array);
+ fp_mergesort (low2, high, temp_array, array);
- dprintf ("mergesort: low1 = %d", low1);
+ dprintf ("fp_mergesort: low1 = %d", low1);
dprintf ("; high1 = %d", high1);
dprintf ("; low2 = %d", low2);
dprintf ("; high2 = %d\n", high2);
}
}
}
- return;
}
int
/* -*-C-*-
-$Id: foreign.c,v 1.2 1999/01/02 06:11:34 cph Exp $
+$Id: foreign.c,v 1.3 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1992, 1999 Massachusetts Institute of Technology
+Copyright (c) 1992, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
}
#ifdef HAVE_DYNAMIC_LOADING
-#ifdef _HPUX
+#ifdef __HPUX__
#include <dl.h>
LOAD_INFO *
NULL);
}
-#endif /* _HPUX */
+#endif /* __HPUX__ */
#endif /* HAVE_DYNAMIC_LOADING */
\f
/* Definitions of primitives */
/* -*-C-*-
-$Id: foreign.h,v 1.2 1999/01/02 06:11:34 cph Exp $
+$Id: foreign.h,v 1.3 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1992, 1999 Massachusetts Institute of Technology
+Copyright (c) 1992, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
typedef struct foreign_object FOREIGN_OBJECT;
-#ifdef _HPUX
+#ifdef __HPUX__
typedef shl_t LOAD_DESCRIPTOR;
typedef unsigned long LOAD_ADDRESS;
#endif
/* -*-C-*-
-$Id: gccode.h,v 9.56 1999/01/02 06:11:34 cph Exp $
+$Id: gccode.h,v 9.57 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#ifndef BAD_TYPES_INNOCUOUS
-#define GC_BAD_TYPE(name) \
-do \
+#define GC_BAD_TYPE(name, object) do \
{ \
sprintf \
(gc_death_message_buffer, \
- "%s: bad type code (0x%02x)", \
+ "%s: bad type code (0x%02lx)", \
(name), \
- (OBJECT_TYPE (Temp))); \
+ (OBJECT_TYPE (object))); \
gc_death \
(TERM_INVALID_TYPE_CODE, \
gc_death_message_buffer, \
#else /* BAD_TYPES_INNOCUOUS */
-#define GC_BAD_TYPE(name) \
-do \
+#define GC_BAD_TYPE(name, object) do \
{ \
- outf_error ("\n%s: bad type code (0x%02x) 0x%lx", \
+ outf_error ("\n%s: bad type code (0x%02lx) 0x%lx", \
(name), \
- (OBJECT_TYPE (Temp)), \
- Temp); \
+ (OBJECT_TYPE (object)), \
+ (object)); \
outf_error (" -- Treating as non-pointer.\n"); \
/* Fall through */ \
} while (0)
first line when "optimizing".
*/
-#ifdef hp9000s800
+#if defined(hp9000s800) || defined(__hp9000s800)
SCHEME_OBJECT gccode_HPUX_lossage_bug_fix_fnord; /* ``I'm not dead yet!'' */
#define RAW_POINTER_END() \
check_transport_vector_lossage (Scan, Saved_Scan, To); \
if ((OBJECT_DATUM (*Old)) > 65536) \
{ \
- outf_error ("\nWarning: copying large vector: %d\n", \
+ outf_error ("\nWarning: copying large vector: %ld\n", \
(OBJECT_DATUM (*Old))); \
outf_flush_error (); \
} \
{ \
sprintf \
(gc_death_message_buffer, \
- "real_transport_vector: vector length too large (%d)", \
+ "real_transport_vector: vector length too large (%ld)", \
(OBJECT_DATUM (*Old))); \
gc_death (TERM_EXIT, gc_death_message_buffer, Saved_Scan, To); \
} \
/* -*-C-*-
-$Id: gcloop.c,v 9.46 1999/01/02 06:11:34 cph Exp $
+$Id: gcloop.c,v 9.47 2000/12/05 21:23:44 cph Exp $
Copyright (c) 1987-1999 Massachusetts Institute of Technology
break;
default:
- GC_BAD_TYPE ("gcloop");
+ GC_BAD_TYPE ("gcloop", Temp);
/* Fall Through */
case_Non_Pointer:
/* -*-C-*-
-$Id: hooks.c,v 9.58 1999/01/02 06:11:34 cph Exp $
+$Id: hooks.c,v 9.59 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
{
extern SCHEME_OBJECT EXFUN (compiled_with_stack_marker, (SCHEME_OBJECT));
- STACK_POP ();
+ (void) STACK_POP ();
return (compiled_with_stack_marker (thunk));
}
else
{
PRIMITIVE_CANONICALIZE_CONTEXT ();
- STACK_POP ();
+ (void) STACK_POP ();
STACK_PUSH (MAKE_OBJECT (TC_RETURN_CODE, RC_STACK_MARKER));
Will_Push (STACK_ENV_EXTRA_SLOTS + 1);
STACK_PUSH (thunk);
/* -*-C-*-
-$Id: hppacach.h,v 1.5 1999/01/02 06:11:34 cph Exp $
+$Id: hppacach.h,v 1.6 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include <fcntl.h>
-#ifdef _HPUX
+#ifdef __HPUX__
#include <sys/utsname.h>
#include <sys/types.h>
#include <sys/param.h>
#include <machine/cpu.h>
#include <machine/pdc_rqsts.h>
-#endif /* _HPUX */
+#endif /* __HPUX__ */
\f
/* PDC_CACHE (processor dependent code cache information call)
return data destructuring.
struct tlb_info DT_info;
};
-#ifdef _HPUX
+#ifdef __HPUX__
# define HARDWARE_SIZE sizeof (utsname.machine)
-#else /* not _HPUX */
+#else /* not __HPUX__ */
/* Presumably BSD */
# define HARDWARE_SIZE 9
int filler[2];
};
-#endif /* _HPUX */
+#endif /* __HPUX__ */
struct pdc_cache_dump
{
/* -*-C-*-
-$Id: hppanwca.c,v 1.4 1999/01/02 06:11:34 cph Exp $
+$Id: hppanwca.c,v 1.5 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
*/
#include <stdio.h>
-#define _HPUX
+#define __HPUX__
#include "hppacach.h"
struct pdc_cache_written
--- /dev/null
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5 (mit/util/scripts/install.sh).
+#
+# Copyright 1991 by the Massachusetts Institute of Technology
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of M.I.T. not be used in advertising or
+# publicity pertaining to distribution of the software without specific,
+# written prior permission. M.I.T. makes no representations about the
+# suitability of this software for any purpose. It is provided "as is"
+# without express or implied warranty.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch. It can only install one file at a time, a restriction
+# shared with many OS's install programs.
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+transformbasename=""
+transform_arg=""
+instcmd="$mvprog"
+chmodcmd="$chmodprog 0755"
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+dir_arg=""
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -d) dir_arg=true
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ -t=*) transformarg=`echo $1 | sed 's/-t=//'`
+ shift
+ continue;;
+
+ -b=*) transformbasename=`echo $1 | sed 's/-b=//'`
+ shift
+ continue;;
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ # this colon is to work around a 386BSD /bin/sh bug
+ :
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+else
+ true
+fi
+
+if [ x"$dir_arg" != x ]; then
+ dst=$src
+ src=""
+
+ if [ -d $dst ]; then
+ instcmd=:
+ chmodcmd=""
+ else
+ instcmd=mkdir
+ fi
+else
+
+# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
+# might cause directories to be created, which would be especially bad
+# if $src (and thus $dsttmp) contains '*'.
+
+ if [ -f $src -o -d $src ]
+ then
+ true
+ else
+ echo "install: $src does not exist"
+ exit 1
+ fi
+
+ if [ x"$dst" = x ]
+ then
+ echo "install: no destination specified"
+ exit 1
+ else
+ true
+ fi
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+ if [ -d $dst ]
+ then
+ dst="$dst"/`basename $src`
+ else
+ true
+ fi
+fi
+
+## this sed command emulates the dirname command
+dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
+
+# Make sure that the destination directory exists.
+# this part is taken from Noah Friedman's mkinstalldirs script
+
+# Skip lots of stat calls in the usual case.
+if [ ! -d "$dstdir" ]; then
+defaultIFS='
+'
+IFS="${IFS-${defaultIFS}}"
+
+oIFS="${IFS}"
+# Some sh's can't handle IFS=/ for some reason.
+IFS='%'
+set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
+IFS="${oIFS}"
+
+pathcomp=''
+
+while [ $# -ne 0 ] ; do
+ pathcomp="${pathcomp}${1}"
+ shift
+
+ if [ ! -d "${pathcomp}" ] ;
+ then
+ $mkdirprog "${pathcomp}"
+ else
+ true
+ fi
+
+ pathcomp="${pathcomp}/"
+done
+fi
+
+if [ x"$dir_arg" != x ]
+then
+ $doit $instcmd $dst &&
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
+else
+
+# If we're going to rename the final executable, determine the name now.
+
+ if [ x"$transformarg" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ dstfile=`basename $dst $transformbasename |
+ sed $transformarg`$transformbasename
+ fi
+
+# don't allow the sed command to completely eliminate the filename
+
+ if [ x"$dstfile" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ true
+ fi
+
+# Make a temp file name in the proper directory.
+
+ dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+ $doit $instcmd $src $dsttmp &&
+
+ trap "rm -f ${dsttmp}" 0 &&
+
+# and set any options; do chmod last to preserve setuid bits
+
+# If any of these fail, we abort the whole thing. If we want to
+# ignore errors from any of these, just make sure not to ignore
+# errors from the above "$doit $instcmd $src $dsttmp" command.
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
+
+# Now rename the file to the real destination.
+
+ $doit $rmcmd -f $dstdir/$dstfile &&
+ $doit $mvcmd $dsttmp $dstdir/$dstfile
+
+fi &&
+
+
+exit 0
/* -*-C-*-
-$Id: intern.c,v 9.56 1999/01/02 06:11:34 cph Exp $
+$Id: intern.c,v 9.57 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "prims.h"
#include "trap.h"
-extern int EXFUN (strlen, (const char *));
+#ifdef STDC_HEADERS
+# include <string.h>
+#else
+ extern int EXFUN (strlen, (const char *));
+#endif
/* These are exported to other parts of the system. */
}
/* Set this to be informed of symbols as they are interned. */
-void (*intern_symbol_hook) () = ((void (*) ()) 0);
+void EXFUN ((*intern_symbol_hook), (SCHEME_OBJECT)) = 0;
static SCHEME_OBJECT
DEFUN (link_new_symbol, (symbol, cell),
/* -*-C-*-
-$Id: interp.c,v 9.89 1999/01/02 06:06:43 cph Exp $
+$Id: interp.c,v 9.90 2000/12/05 21:23:44 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
preserve_signal_mask ();
Set_Time_Zone (Zone_Working);
Import_Registers ();
- \f
+
Repeat_Dispatch:
switch (Which_Way)
{
LOG_FUTURES();
case CODE_MAP(PRIM_REENTER):
goto Perform_Application;
- \f
+
case PRIM_TOUCH:
{
SCHEME_OBJECT temp;
Pop_Return_Error(Which_Way);
}
}
- \f
+
Do_Expression:
if (0 && Eval_Debug)
Pushed ();
goto Apply_Non_Trapping;
}
- \f
+
Eval_Non_Trapping:
Eval_Ucode_Hook();
switch (OBJECT_TYPE (Fetch_Expression()))
Export_Registers();
Microcode_Termination (TERM_BROKEN_HEART);
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case TC_COMBINATION:
{
long Array_Length;
goto return_from_compiled_code;
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case TC_DEFINITION:
Will_Push(CONTINUATION_SIZE + 1);
Save_Env();
Free += 2;
break;
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
#ifdef COMPILE_FUTURES
case TC_FUTURE:
if (Future_Has_Value(Fetch_Expression()))
case TC_MANIFEST_SPECIAL_NM_VECTOR:
Eval_Error(ERR_EXECUTE_MANIFEST_VECTOR);
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
/*
The argument to Will_Eventually_Push is determined by how much
will be on the stack if we back out of the primitive.
case TC_THE_ENVIRONMENT:
Val = Fetch_Env(); break;
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case TC_VARIABLE:
{
long temp;
cell = lookup_fluid(Val);
goto lookup_end_restart;
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case TRAP_UNBOUND:
temp = ERR_UNBOUND_VARIABLE;
break;
SITE_EXPRESSION_DISPATCH_HOOK()
};
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
/* Now restore the continuation saved during an earlier part
* of the EVAL cycle and continue as directed.
*/
Save_Env();
Do_Another_Then(RC_COMB_2_PROCEDURE, COMB_2_ARG_1);
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case RC_COMB_2_PROCEDURE:
Restore_Env();
STACK_PUSH (Val); /* Arg 1, just calculated */
Do_Another_Then(RC_COMB_APPLY_FUNCTION, COMB_FN_SLOT);
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
#define define_compiler_restart(return_code, entry) \
case return_code: \
{ \
- extern long entry(); \
- compiled_code_restart(); \
- Export_Registers(); \
- Which_Way = entry(); \
- goto return_from_compiled_code; \
- }
+ extern long entry(); \
+ compiled_code_restart(); \
+ Export_Registers(); \
+ Which_Way = entry(); \
+ goto return_from_compiled_code; \
+ }
- define_compiler_restart (RC_COMP_INTERRUPT_RESTART,
- comp_interrupt_restart)
+ define_compiler_restart (RC_COMP_INTERRUPT_RESTART,
+ comp_interrupt_restart)
define_compiler_restart (RC_COMP_LOOKUP_APPLY_RESTART,
comp_lookup_apply_restart)
define_compiler_restart (RC_COMP_UNBOUND_P_RESTART,
comp_unbound_p_restart)
- \f
+
define_compiler_restart (RC_COMP_ASSIGNMENT_RESTART,
comp_assignment_restart)
define_compiler_restart (RC_COMP_ERROR_RESTART,
comp_error_restart)
-\f
- case RC_REENTER_COMPILED_CODE:
- compiled_code_restart();
- Export_Registers();
- Which_Way = return_to_compiled_code();
- goto return_from_compiled_code;
+
+ case RC_REENTER_COMPILED_CODE:
+ compiled_code_restart();
+ Export_Registers();
+ Which_Way = return_to_compiled_code();
+ goto return_from_compiled_code;
case RC_CONDITIONAL_DECIDE:
Pop_Return_Val_Check();
/* Should be called RC_REDO_EVALUATION. */
Store_Env(STACK_POP ());
Reduces_To(Fetch_Expression());
- \f
+
case RC_EXECUTE_ACCESS_FINISH:
{
long Result;
Pop_Return_Error(ERR_BAD_FRAME);
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case RC_EXECUTE_ASSIGNMENT_FINISH:
{
long temp;
SCHEME_OBJECT value;
- Lock_Handle set_serializer;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (set_serializer);
+#endif
#ifndef No_In_Line_Lookup
goto Pop_Return;
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
get_trap_kind(temp, *cell);
switch(temp)
{
case TRAP_FLUID_DANGEROUS:
case TRAP_COMPILER_CACHED_DANGEROUS:
remove_lock(set_serializer);
- cell = OBJECT_ADDRESS (MEMORY_REF (Fetch_Expression(), ASSIGN_NAME));
- temp =
- deep_assignment_end(deep_lookup(Fetch_Env(),
- cell[VARIABLE_SYMBOL],
- cell),
- cell,
- value,
- false);
+ cell
+ = OBJECT_ADDRESS (MEMORY_REF (Fetch_Expression(), ASSIGN_NAME));
+ temp
+ = deep_assignment_end(deep_lookup(Fetch_Env(),
+ cell[VARIABLE_SYMBOL],
+ cell),
+ cell,
+ value,
+ false);
external_assignment_return:
Import_Val();
if (temp != PRIM_DONE)
SCHEME_OBJECT extension, references;
extension = FAST_MEMORY_REF (Val, TRAP_EXTRA);
- references = FAST_MEMORY_REF (extension, TRAP_EXTENSION_REFERENCES);
+ references
+ = FAST_MEMORY_REF (extension, TRAP_EXTENSION_REFERENCES);
if ((FAST_MEMORY_REF (references, TRAP_REFERENCES_OPERATOR))
!= SHARP_F)
goto assignment_end_after_lock;
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case TRAP_FLUID:
remove_lock(set_serializer);
cell = lookup_fluid(Val);
if (value == UNASSIGNED_OBJECT)
value = bogus_unassigned;
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
#else /* No_In_Line_Lookup */
value = Val;
Interrupt(PENDING_INTERRUPTS());
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case RC_EXECUTE_DEFINITION_FINISH:
{
SCHEME_OBJECT value;
Import_Registers_Except_Val();
break;
#endif
- \f
+
case RC_HALT:
Export_Registers();
Microcode_Termination (TERM_TERM_HANDLER);
case RC_HARDWARE_TRAP:
{
/* This just reinvokes the handler */
-
- SCHEME_OBJECT info, handler;
- info = (STACK_REF (0));
-
- Save_Cont();
- if ((! (Valid_Fixed_Obj_Vector())) ||
- ((handler = (Get_Fixed_Obj_Slot(Trap_Handler))) == SHARP_F))
+ SCHEME_OBJECT info = (STACK_REF (0));
+ SCHEME_OBJECT handler = SHARP_F;
+ Save_Cont ();
+ if (Valid_Fixed_Obj_Vector ())
+ handler = (Get_Fixed_Obj_Slot (Trap_Handler));
+ if (handler == SHARP_F)
{
outf_fatal ("There is no trap handler for recovery!\n");
termination_trap ();
/*NOTREACHED*/
}
- Will_Push(STACK_ENV_EXTRA_SLOTS + 2);
+ Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
STACK_PUSH (info);
STACK_PUSH (handler);
STACK_PUSH (STACK_FRAME_HEADER + 1);
- Pushed();
- goto Internal_Apply;
+ Pushed ();
}
- \f
+ goto Internal_Apply;
+
/* Internal_Apply, the core of the application mechanism.
Branch here to perform a function application.
*/
#define Prepare_Apply_Interrupt() \
- { \
- Store_Expression (SHARP_F); \
- Prepare_Pop_Return_Interrupt (RC_INTERNAL_APPLY_VAL, \
- (STACK_REF (STACK_ENV_FUNCTION))); \
- }
+ { \
+ Store_Expression (SHARP_F); \
+ Prepare_Pop_Return_Interrupt \
+ (RC_INTERNAL_APPLY_VAL, (STACK_REF (STACK_ENV_FUNCTION))); \
+ }
#define Apply_Error(N) \
{ \
- Store_Expression (SHARP_F); \
- Store_Return (RC_INTERNAL_APPLY_VAL); \
- Val = (STACK_REF (STACK_ENV_FUNCTION)); \
- Pop_Return_Error (N); \
- }
-
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
+ Store_Expression (SHARP_F); \
+ Store_Return (RC_INTERNAL_APPLY_VAL); \
+ Val = (STACK_REF (STACK_ENV_FUNCTION)); \
+ Pop_Return_Error (N); \
+ }
case RC_INTERNAL_APPLY_VAL:
Internal_Apply_Val:
goto Internal_Apply;
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case TC_RECORD:
{
SCHEME_OBJECT record_type = (VECTOR_REF (Function, 0));
}
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case TC_CONTROL_POINT:
{
if (OBJECT_DATUM (STACK_REF (STACK_ENV_HEADER)) !=
goto Pop_Return;
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
/*
After checking the number of arguments, remove the
frame header since primitives do not expect it.
goto Pop_Return;
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case TC_EXTENDED_PROCEDURE:
{
SCHEME_OBJECT lambda, temp;
0));
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
scan = Free;
temp = (MAKE_POINTER_OBJECT (TC_ENVIRONMENT, scan));
*scan++ = MAKE_OBJECT (TC_MANIFEST_VECTOR, size);
Reduces_To(Get_Body_Elambda(lambda));
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case TC_COMPILED_ENTRY:
{
apply_compiled_setup
Prepare_Apply_Interrupt ();
Interrupt (PENDING_INTERRUPTS ());
}
- \f
+
case ERR_INAPPLICABLE_OBJECT:
/* This error code means that apply_compiled_procedure
was called on an object which is not a compiled procedure,
*/
execute_compiled_backout ();
- Val =
- (OBJECT_NEW_TYPE (TC_COMPILED_ENTRY, (Fetch_Expression ())));
+ Val
+ = (OBJECT_NEW_TYPE
+ (TC_COMPILED_ENTRY, (Fetch_Expression ())));
Pop_Return_Error (Which_Way);
}
} /* End of switch in RC_INTERNAL_APPLY */
} /* End of RC_INTERNAL_APPLY case */
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case RC_MOVE_TO_ADJACENT_POINT:
/* Expression contains the space in which we are moving */
{
Thunk = FAST_MEMORY_REF (Current, STATE_POINT_AFTER_THUNK);
New_Location = FAST_MEMORY_REF (Current, STATE_POINT_NEARER_POINT);
STACK_REF(TRANSLATE_FROM_POINT) = New_Location;
- if ((From_Count == 1) &&
- (STACK_REF(TRANSLATE_TO_DISTANCE) == LONG_TO_UNSIGNED_FIXNUM(0)))
+ if ((From_Count == 1)
+ && ((STACK_REF (TRANSLATE_TO_DISTANCE))
+ == (LONG_TO_UNSIGNED_FIXNUM (0))))
Stack_Pointer = (STACK_LOC (4));
else Save_Cont();
}
fast SCHEME_OBJECT To_Location;
fast long i;
- To_Count =
- (UNSIGNED_FIXNUM_TO_LONG (STACK_REF (TRANSLATE_TO_DISTANCE)) - 1);
+ To_Count
+ = ((UNSIGNED_FIXNUM_TO_LONG (STACK_REF (TRANSLATE_TO_DISTANCE)))
+ - 1);
To_Location = STACK_REF(TRANSLATE_TO_POINT);
for (i = 0; i < To_Count; i++)
{
}
Thunk = FAST_MEMORY_REF (To_Location, STATE_POINT_BEFORE_THUNK);
New_Location = To_Location;
- STACK_REF(TRANSLATE_TO_DISTANCE) = LONG_TO_UNSIGNED_FIXNUM(To_Count);
+ (STACK_REF (TRANSLATE_TO_DISTANCE))
+ = (LONG_TO_UNSIGNED_FIXNUM (To_Count));
if (To_Count == 0)
{
Stack_Pointer = (STACK_LOC (4));
}
else
{
- Save_Cont();
+ Save_Cont ();
}
}
if ((Fetch_Expression ()) != SHARP_F)
goto Internal_Apply;
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case RC_INVOKE_STACK_THREAD:
/* Used for WITH_THREADED_STACK primitive */
Will_Push(3);
EXIT_CRITICAL_SECTION ({ Save_Cont(); Export_Registers(); });
End_GC_Hook ();
break;
- \f
+
case RC_PCOMB1_APPLY:
End_Subproblem();
STACK_PUSH (Val); /* Argument value */
}
break;
}
- \f
+
case RC_PCOMB2_APPLY:
End_Subproblem();
STACK_PUSH (Val); /* Value of arg. 1 */
Store_Expression(FAST_MEMORY_REF (Fetch_Expression(), PCOMB3_FN_SLOT));
goto Primitive_Internal_Apply;
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case RC_PCOMB3_DO_1:
{
SCHEME_OBJECT Temp;
Restore_Cont();
goto Repeat_Dispatch;
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
/* The following two return codes are both used to restore
a saved history object. The difference is that the first
does not copy the history object while the second does.
break;
}
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case RC_RESTORE_HISTORY:
{
SCHEME_OBJECT Stacklet;
Stack_Pointer = (STACK_LOCATIVE_OFFSET (Stack_Pointer, 1));
break;
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case RC_RESTORE_TO_STATE_POINT:
{
SCHEME_OBJECT Where_To_Go = Fetch_Expression();
Restore_Env();
Reduces_To_Nth(SEQUENCE_3);
- /* Interpret() continues on the next page */
- \f
- /* Interpret(), continued */
-
case RC_SNAP_NEED_THUNK:
/* Don't snap thunk twice; evaluation of the thunk's body might
have snapped it already. */
/* -*-C-*-
-$Id: interp.h,v 9.41 1999/01/02 06:11:34 cph Exp $
+$Id: interp.h,v 9.42 2000/12/05 21:23:45 cph Exp $
Copyright (c) 1987-1999 Massachusetts Institute of Technology
{ \
STACK_PUSH (Expression); \
STACK_PUSH (Return); \
- Cont_Print (); \
}
#define Restore_Cont() \
{ \
Return = (STACK_POP ()); \
Expression = (STACK_POP ()); \
- if (Cont_Debug) \
- { \
- Print_Return(RESTORE_CONT_RETURN_MESSAGE); \
- Print_Expression(Fetch_Expression(), \
- RESTORE_CONT_EXPR_MESSAGE); \
- printf ("\n"); \
- } \
-}
-
-#define Cont_Print() \
-{ \
- if (Cont_Debug) \
- { \
- Print_Return(CONT_PRINT_RETURN_MESSAGE); \
- Print_Expression(Fetch_Expression(), \
- CONT_PRINT_EXPR_MESSAGE); \
- printf ("\n"); \
- } \
}
#define Stop_Trapping() \
/* -*-C-*-
-$Id: intrpt.h,v 1.20 1999/01/02 06:11:34 cph Exp $
+$Id: intrpt.h,v 1.21 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
RELEASE_INTERRUPT_REGISTERS (); \
}
-#if defined(_OS2) || defined(WINNT)
-
-#define GRAB_INTERRUPT_REGISTERS() OS_grab_interrupt_registers ()
-#define RELEASE_INTERRUPT_REGISTERS() OS_release_interrupt_registers ()
-
-extern void OS_grab_interrupt_registers (void);
-extern void OS_release_interrupt_registers (void);
-
-#else /* not (_OS2 or WINNT) */
-
-#define GRAB_INTERRUPT_REGISTERS()
-#define RELEASE_INTERRUPT_REGISTERS()
-
-#endif /* not (_OS2 or WINNT) */
+#if defined(__OS2__) || defined(__WIN32__)
+ extern void OS_grab_interrupt_registers (void);
+ extern void OS_release_interrupt_registers (void);
+# define GRAB_INTERRUPT_REGISTERS() OS_grab_interrupt_registers ()
+# define RELEASE_INTERRUPT_REGISTERS() OS_release_interrupt_registers ()
+#else
+# define GRAB_INTERRUPT_REGISTERS()
+# define RELEASE_INTERRUPT_REGISTERS()
+#endif
/* -*-C-*-
-$Id: liarc.h,v 1.14 1999/01/02 06:06:43 cph Exp $
+$Id: liarc.h,v 1.15 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#endif
\f
#include <stdio.h>
-#include "ansidecl.h"
#include "config.h"
#include "dstack.h"
#include "default.h"
#define DOUBLE_ATAN2 atan2
\f
#ifdef __GNUC__
-# ifdef hp9000s800
+# if defined(hp9000s800) || defined(__hp9000s800)
# define BUG_GCC_LONG_CALLS
# endif
#endif
/* -*-C-*-
-$Id: lookprm.c,v 1.11 1999/01/02 06:11:34 cph Exp $
+$Id: lookprm.c,v 1.12 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
It makes heavy use of procedures in lookup.c */
#include "scheme.h"
+#include "prims.h"
#include "locks.h"
#include "trap.h"
#include "lookup.h"
-#include "prims.h"
/* NOTE:
Although this code has been parallelized, it has not been
/* -*-C-*-
-$Id: lookup.c,v 9.57 1999/01/02 06:06:43 cph Exp $
+$Id: lookup.c,v 9.58 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "trap.h"
#include "lookup.h"
+static void EXFUN (fix_references, (SCHEME_OBJECT *, SCHEME_OBJECT));
+static long EXFUN
+ (add_reference, (SCHEME_OBJECT *, SCHEME_OBJECT, SCHEME_OBJECT));
+
/* NOTE:
Although this code has been parallelized, it has not been
exhaustively tried on a parallel processor. There are probably
AND long depth
AND Boolean unbound_valid_p)
{
- Lock_Handle compile_serializer;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (compile_serializer);
+#endif
fast SCHEME_OBJECT *scan, temp;
fast long count;
AND SCHEME_OBJECT sym
AND SCHEME_OBJECT * hunk)
{
- Lock_Handle compile_serializer;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (compile_serializer);
+#endif
fast SCHEME_OBJECT frame;
fast long depth;
SCHEME_OBJECT * cell
AND SCHEME_OBJECT * hunk)
{
- long trap_kind, return_value;
+ long trap_kind;
+ long return_value = PRIM_DONE;
Boolean repeat_p;
do {
/* The reference was dangerous, uncompile the variable. */
{
- Lock_Handle compile_serializer;
-
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (compile_serializer);
+#endif
setup_lock(compile_serializer, hunk);
hunk[VARIABLE_COMPILED_TYPE] = UNCOMPILED_VARIABLE;
hunk[VARIABLE_OFFSET] = SHARP_F;
AND SCHEME_OBJECT value
AND Boolean force)
{
- Lock_Handle set_serializer;
- long trap_kind, return_value;
- SCHEME_OBJECT bogus_unassigned, extension, saved_extension, saved_value;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (set_serializer);
+#endif
+ long trap_kind;
+ long return_value = PRIM_DONE;
+ SCHEME_OBJECT bogus_unassigned, extension, saved_extension;
+ SCHEME_OBJECT saved_value = SHARP_F;
Boolean repeat_p, uncompile_p, fluid_lock_p;
/* State variables */
\f
if (saved_extension != SHARP_F)
{
- long recache_uuo_links ();
-
if (fluid_lock_p)
{
/* Guarantee that there is a lock on the variable cache around
if (uncompile_p)
{
/* The reference was dangerous, uncompile the variable. */
-
- Lock_Handle compile_serializer;
-
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (compile_serializer);
+#endif
setup_lock (compile_serializer, hunk);
hunk[VARIABLE_COMPILED_TYPE] = UNCOMPILED_VARIABLE;
hunk[VARIABLE_OFFSET] = SHARP_F;
AND SCHEME_OBJECT * hunk
AND SCHEME_OBJECT value)
{
- Lock_Handle set_serializer;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (set_serializer);
+#endif
SCHEME_OBJECT bogus_unassigned;
long temp;
return (redefinition (cell, value));
else
{
- Lock_Handle set_serializer;
-
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (set_serializer);
+#endif
setup_lock (set_serializer, cell);
if (*cell == DANGEROUS_UNBOUND_OBJECT)
{
fast SCHEME_OBJECT * cell
AND SCHEME_OBJECT sym)
{
- Lock_Handle set_serializer;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (set_serializer);
+#endif
fast long temp;
SCHEME_OBJECT trap;
AND SCHEME_OBJECT original_frame
AND Boolean recache_p)
{
- Lock_Handle extension_serializer;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (extension_serializer);
+#endif
SCHEME_OBJECT extension, the_procedure;
fast SCHEME_OBJECT *scan;
long aux_count;
(long, SCHEME_OBJECT, SCHEME_OBJECT,
SCHEME_OBJECT, long, SCHEME_OBJECT));
- Lock_Handle set_serializer;
- fast SCHEME_OBJECT trap, references, extension;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (set_serializer);
+#endif
+ fast SCHEME_OBJECT trap, references;
+ SCHEME_OBJECT extension = SHARP_F;
SCHEME_OBJECT trap_value, store_trap_tag, store_extension;
long trap_kind, return_value;
*/
{
- void fix_references ();
- long add_reference ();
-
references = (FAST_MEMORY_REF (extension, TRAP_EXTENSION_REFERENCES));
if (((kind == TRAP_REFERENCES_ASSIGNMENT) &&
pairs (pairs whose weakly held block has vanished).
*/
-void
+static void
DEFUN (fix_references, (slot, extension),
fast SCHEME_OBJECT * slot
AND fast SCHEME_OBJECT extension)
"emptied" by the garbage collector.
*/
-long
+static long
DEFUN (add_reference, (slot, block, offset),
fast SCHEME_OBJECT * slot
AND SCHEME_OBJECT block
SCHEME_OBJECT * value_cell
AND SCHEME_OBJECT sym)
{
- Lock_Handle set_serializer;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (set_serializer);
+#endif
SCHEME_OBJECT val, extension, references;
long trap_kind, temp, i, index;
AND Boolean shadowed_p
AND Boolean link_p)
{
- Lock_Handle set_serializer_1, set_serializer_2;
+#ifdef DECLARE_LOCK
+ DECLARE_LOCK (set_serializer_1);
+ DECLARE_LOCK (set_serializer_2);
+#endif
SCHEME_OBJECT
- old_value, references, extension, new_extension, new_trap,
+ old_value, references, extension, new_extension,
*trap_info_table[TRAP_MAP_TABLE_SIZE];
+ SCHEME_OBJECT new_trap = SHARP_F;
long
trap_kind, temp, i, index, total_size, total_count, conflict_count;
/* -*-C-*-
-$Id: lookup.h,v 9.51 1999/01/02 06:06:43 cph Exp $
+$Id: lookup.h,v 9.52 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
EXFUN (deep_assignment_end,
(SCHEME_OBJECT *, SCHEME_OBJECT *, SCHEME_OBJECT, Boolean));
+extern long EXFUN (recache_uuo_links, (SCHEME_OBJECT, SCHEME_OBJECT));
+
extern SCHEME_OBJECT
unbound_trap_object[],
uncompiled_trap_object[],
/* Common constants. */
-#ifdef b32 /* 32 bit objects */
-
-#if (TYPE_CODE_LENGTH == 8)
-#define UNCOMPILED_VARIABLE 0x08000000
-#endif
-
-#if (TYPE_CODE_LENGTH == 6)
-#define UNCOMPILED_VARIABLE 0x20000000
+#if (SIZEOF_UNSIGNED_LONG == 4) /* 32 bit objects */
+# if (TYPE_CODE_LENGTH == 8)
+# define UNCOMPILED_VARIABLE 0x08000000
+# endif
+# if (TYPE_CODE_LENGTH == 6)
+# define UNCOMPILED_VARIABLE 0x20000000
+# endif
+# if (TC_CONSTANT != 0x08)
+# include "error:lookup.h and types.h are inconsistent"
+# endif
#endif
-#if (TC_CONSTANT != 0x08)
-#include "error:lookup.h and types.h are inconsistent"
-#endif
-
-#endif /* b32 */
-
#ifndef UNCOMPILED_VARIABLE /* Safe version */
#define UNCOMPILED_VARIABLE MAKE_OBJECT (UNCOMPILED_REF, 0)
#endif
not matter, but might on a machine with address mapping.
*/
+#define DECLARE_LOCK(name) Lock_Handle name
#define setup_lock(handle, cell) handle = Lock_Cell(cell)
#define remove_lock(handle) Unlock_Cell(handle)
\f
#define verify(type_code, variable, code, label)
#define verified_offset(variable, code) code
+/* #undef DECLARE_LOCK */
#define setup_lock(handle, cell)
#define remove_lock(ignore)
#define setup_locks(hand1, cel1, hand2, cel2)
--- /dev/null
+# $Id: Makefile.in.in,v 1.2 2000/12/05 21:23:50 cph Exp $
+#
+# Copyright (c) 2000 Massachusetts Institute of Technology
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or (at
+# your option) any later version.
+#
+# 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, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# **** BEGIN BOILERPLATE ****
+
+SHELL = @SHELL@
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+bindir = @bindir@
+sbindir = @sbindir@
+libexecdir = @libexecdir@
+datadir = @datadir@
+sysconfdir = @sysconfdir@
+sharedstatedir = @sharedstatedir@
+localstatedir = @localstatedir@
+libdir = @libdir@
+infodir = @infodir@
+mandir = @mandir@
+includedir = @includedir@
+oldincludedir = /usr/include
+
+DESTDIR =
+top_builddir = .
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@ $(AM_INSTALL_PROGRAM_FLAGS)
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+transform = @program_transform_name@
+
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_HEADER = config.h
+CONFIG_CLEAN_FILES =
+
+# **** END BOILERPLATE ****
+
+# **** Tool configuration ****
+
+CC = @CC@
+M4 = $(srcdir)/makegen/m4.sh
+AS = as
+TAR = tar
+GZIP_ENV = --best
+
+DEFS = -DMIT_SCHEME @DEFS@ -I. -I$(srcdir) -I.
+CFLAGS = @CFLAGS@
+X_CFLAGS = @X_CFLAGS@
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+M4_FLAGS = @M4_FLAGS@
+AS_FLAGS = @AS_FLAGS@
+
+COMPILE = $(CC) $(DEFS) $(CPPFLAGS) $(CFLAGS) $(X_CFLAGS)
+CCLD = $(CC)
+LINK = $(CCLD) $(CFLAGS) $(LDFLAGS) -o $@
+EXPAND = $(M4) $(M4_FLAGS)
+ASSEMBLE = $(AS) $(AS_FLAGS)
+
+# **** Configured files ****
+
+GC_HEAD_FILES = @GC_HEAD_FILES@
+OPTIONAL_SOURCES = @OPTIONAL_SOURCES@
+OPTIONAL_OBJECTS = @OPTIONAL_OBJECTS@
+STATIC_LIBS = @STATIC_PREFIX@ @STATIC_LIBS@ @STATIC_SUFFIX@
+STATIC_PREFIX = @STATIC_PREFIX@
+STATIC_SUFFIX = @STATIC_SUFFIX@
+X_LIBS = @X_PRE_LIBS@ @LIB_X11@ @X_EXTRA_LIBS@
+
+# **** Non-configured files ****
+
+CORE_SOURCES = @(write-sources "files-core")@
+OS_PRIM_SOURCES = @(write-sources "files-os-prim")@
+UNIX_SOURCES = @(write-sources "files-unix")@
+STD_GC_SOURCES = @(write-sources "files-gc-std")@
+BCH_GC_SOURCES = @(write-sources "files-gc-bch")@
+
+CORE_OBJECTS = @(write-objects "files-core")@
+OS_PRIM_OBJECTS = @(write-objects "files-os-prim")@
+UNIX_OBJECTS = @(write-objects "files-unix")@
+STD_GC_OBJECTS = @(write-objects "files-gc-std")@
+BCH_GC_OBJECTS = @(write-objects "files-gc-bch")@
+
+SHARED_SOURCES = $(CORE_SOURCES) $(OS_PRIM_SOURCES) $(UNIX_SOURCES) \
+ $(OPTIONAL_SOURCES)
+
+SHARED_OBJECTS = $(CORE_OBJECTS) $(OS_PRIM_OBJECTS) $(UNIX_OBJECTS) \
+ $(OPTIONAL_OBJECTS)
+
+# **** Program definitions ****
+
+bin_PROGRAMS = scheme bchscheme
+lib_PROGRAMS = bchdrn
+EXTRA_PROGRAMS = findprim bintopsb psbtobin
+
+scheme_SOURCES = $(SHARED_SOURCES) $(STD_GC_SOURCES) usrdef.c
+scheme_OBJECTS = $(SHARED_OBJECTS) $(STD_GC_OBJECTS) usrdef.o
+scheme_DEPENDENCIES =
+scheme_LDFLAGS = @X_LIBS@
+scheme_LIBS = $(STATIC_LIBS) $(X_LIBS) $(LIBS)
+
+bchscheme_SOURCES = $(SHARED_SOURCES) $(BCH_GC_SOURCES) bchdef.c
+bchscheme_OBJECTS = $(SHARED_OBJECTS) $(BCH_GC_OBJECTS) bchdef.o
+bchscheme_DEPENDENCIES =
+bchscheme_LDFLAGS = @X_LIBS@
+bchscheme_LIBS = $(STATIC_LIBS) $(X_LIBS) $(LIBS)
+
+bchdrn_SOURCES = bchdrn.c bchutl.c
+bchdrn_OBJECTS = bchdrn.o bchutl.o
+bchdrn_DEPENDENCIES =
+bchdrn_LDFLAGS =
+bchdrn_LIBS = $(LIBS)
+
+findprim_SOURCES = findprim.c
+findprim_OBJECTS = findprim.o
+findprim_DEPENDENCIES =
+findprim_LDFLAGS =
+findprim_LIBS = $(LIBS)
+
+bintopsb_SOURCES = bintopsb.c missing.c
+bintopsb_OBJECTS = bintopsb.o missing.o
+bintopsb_DEPENDENCIES =
+bintopsb_LDFLAGS =
+bintopsb_LIBS = $(LIBS)
+
+psbtobin_SOURCES = psbtobin.c missing.c
+psbtobin_OBJECTS = psbtobin.o missing.o
+psbtobin_DEPENDENCIES =
+psbtobin_LDFLAGS =
+psbtobin_LIBS = $(LIBS)
+
+ALL_PROGRAMS = $(bin_PROGRAMS) $(lib_PROGRAMS)
+
+MOSTLYCLEAN_FILES = *.o cmpauxmd.s usrdef.c bchdef.c
+
+CLEAN_FILES = $(ALL_PROGRAMS) $(EXTRA_PROGRAMS)
+
+DISTCLEAN_FILES = Makefile config.h config.cache config.log config.status \
+ cmpauxmd.m4 cmpintmd.h TAGS
+
+MAINTAINER_CLEAN_FILES = Makefile.in makegen/Makefile.deps \
+ config.h.in configure
+
+SUBDIRS = cmpauxmd
+
+# **** Implicit rules ****
+
+.SUFFIXES:
+.SUFFIXES: .c .o .s .m4
+
+.c.o:
+ $(COMPILE) -c $*.c
+
+.m4.s:
+ $(EXPAND) $*.m4 > $*.s
+
+.s.o:
+ $(ASSEMBLE) -o $*.o $*.s
+
+# **** Main rules ****
+
+all: $(ALL_PROGRAMS)
+ @for subdir in $(SUBDIRS); do \
+ echo "making $@ in $$subdir"; \
+ ( cd $$subdir && $(MAKE) $@ ) || exit 1; \
+ done
+
+scheme: $(scheme_OBJECTS) $(scheme_DEPENDENCIES)
+ -rm -f scheme
+ $(LINK) $(scheme_LDFLAGS) $(scheme_OBJECTS) $(scheme_LIBS)
+
+usrdef.c: $(SHARED_SOURCES) $(STD_GC_SOURCES) findprim
+ -rm -f usrdef.c
+ ./findprim $(SHARED_SOURCES) $(STD_GC_SOURCES) > usrdef.c
+
+bchscheme: $(bchscheme_OBJECTS) $(bchscheme_DEPENDENCIES)
+ -rm -f bchscheme
+ $(LINK) $(bchscheme_LDFLAGS) $(bchscheme_OBJECTS) $(bchscheme_LIBS)
+
+bchdef.c: $(SHARED_SOURCES) $(BCH_GC_SOURCES) findprim
+ -rm -f bchdef.c
+ ./findprim $(SHARED_SOURCES) $(BCH_GC_SOURCES) > bchdef.c
+
+bchdrn: $(bchdrn_OBJECTS) $(bchdrn_DEPENDENCIES)
+ -rm -f bchdrn
+ $(LINK) $(bchdrn_LDFLAGS) $(bchdrn_OBJECTS) $(bchdrn_LIBS)
+
+findprim: $(findprim_OBJECTS) $(findprim_DEPENDENCIES)
+ -rm -f findprim
+ $(LINK) $(findprim_LDFLAGS) $(findprim_OBJECTS) $(findprim_LIBS)
+
+bintopsb: $(bintopsb_OBJECTS) $(bintopsb_DEPENDENCIES)
+ -rm -f bintopsb
+ $(LINK) $(bintopsb_LDFLAGS) $(bintopsb_OBJECTS) $(bintopsb_LIBS)
+
+psbtobin: $(psbtobin_OBJECTS) $(psbtobin_DEPENDENCIES)
+ -rm -f psbtobin
+ $(LINK) $(psbtobin_LDFLAGS) $(psbtobin_OBJECTS) $(psbtobin_LIBS)
+
+tags: TAGS
+TAGS:
+ etags -r '/^DEF[A-Za-z_ \t(]+"\([^"]+\)"/' *.[ch]
+
+mostlyclean:
+ -rm -f $(MOSTLYCLEAN_FILES)
+
+clean: mostlyclean
+ -rm -f $(CLEAN_FILES)
+
+distclean: clean
+ -rm -f $(DISTCLEAN_FILES)
+
+maintainer-clean: distclean
+ -rm -f $(MAINTAINER_CLEAN_FILES)
+ @for subdir in $(SUBDIRS); do \
+ echo "making $@ in $$subdir"; \
+ ( cd $$subdir && $(MAKE) $@ ) || exit 1; \
+ done
+
+.PHONY: all tags TAGS mostlyclean clean distclean maintainer-clean
+
+# **** File dependencies ****
+
+@(write-dependencies)@
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
--- /dev/null
+#| -*-Scheme-*-
+
+$Id: files-core.scm,v 1.2 2000/12/05 21:23:50 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+;;;; Core C files used on all platforms.
+
+"artutl"
+"avltree"
+"bignum"
+"bigprm"
+"bitstr"
+"boot"
+"char"
+"comutl"
+"daemon"
+"debug"
+"dfloat"
+"error"
+"extern"
+"fasload"
+"fixnum"
+"flonum"
+"generic"
+"hooks"
+"hunk"
+"intern"
+"interp"
+"intprm"
+"list"
+"lookprm"
+"lookup"
+"missing"
+"obstack"
+"option"
+"osscheme"
+"ostty"
+"outf"
+"prim"
+"primutl"
+"prmcon"
+"ptrvec"
+"purutl"
+"regex"
+"rgxprim"
+"step"
+"storage"
+"string"
+"syntax"
+"sysprim"
+"term"
+"tterm"
+"transact"
+"utils"
+"vector"
+"wind"
--- /dev/null
+#| -*-Scheme-*-
+
+$Id: files-gc-bch.scm,v 1.2 2000/12/05 21:23:50 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+;;;; C files for one-heap garbage-collector.
+
+"bchdmp"
+"bchgcl"
+"bchmmg"
+"bchpur"
+"bchutl"
--- /dev/null
+#| -*-Scheme-*-
+
+$Id: files-gc-std.scm,v 1.2 2000/12/05 21:23:50 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+;;;; C files for standard garbage collector.
+
+"fasdump"
+"gcloop"
+"memmag"
+"purify"
+"wabbit"
--- /dev/null
+#| -*-Scheme-*-
+
+$Id: files-optional.scm,v 1.2 2000/12/05 21:23:50 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+;;;; Optional C files that are conditionally linked in.
+
+"cmpint"
+"prbfish"
+"prgdbm"
+"prmd5"
+"prmhash"
+"pruxdld"
+"termcap"
+"terminfo"
+"tparam"
+"x11base"
+"x11color"
+"x11graph"
+"x11term"
--- /dev/null
+#| -*-Scheme-*-
+
+$Id: files-os-prim.scm,v 1.2 2000/12/05 21:23:50 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+;;;; C files containing operating-system primitives.
+
+"prosenv"
+"prosfile"
+"prosfs"
+"prosio"
+"prosproc"
+"prospty"
+"prosterm"
+"prostty"
+"pruxsock" ;Misnamed, should be "prossock".
--- /dev/null
+#| -*-Scheme-*-
+
+$Id: files-other.scm,v 1.2 2000/12/05 21:23:50 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+;;;; C files for programs other than Scheme.
+
+"bchdrn"
+"bintopsb"
+"findprim"
+"psbtobin"
--- /dev/null
+#| -*-Scheme-*-
+
+$Id: files-unix.scm,v 1.2 2000/12/05 21:23:50 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+;;;; Unix-specific C files.
+
+"intext"
+"pruxenv"
+"pruxfs"
+"pruxio"
+"ux"
+"uxctty"
+"uxenv"
+"uxfile"
+"uxfs"
+"uxio"
+"uxproc"
+"uxsig"
+"uxsock"
+"uxterm"
+"uxtop"
+"uxtrap"
+"uxtty"
+"uxutil"
--- /dev/null
+#!/bin/sh
+
+# $Id: m4.sh,v 1.2 2000/12/05 21:23:50 cph Exp $
+#
+# Copyright (c) 2000 Massachusetts Institute of Technology
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or (at
+# your option) any later version.
+#
+# 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, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Processing to simulate m4 accepting definition arguments.
+
+if [ $# = 0 ]
+then
+ sed -e '/^#/D' | m4 | sed -e 's/@/$/g' -e 's/^\f$//'
+else
+ TMP_FILE="m4.tmp"
+ SEEN_INPUT=0
+ rm -f "${TMP_FILE}"
+ while [ $# != 0 ]; do
+ if [ "${1}" = "-P" ]; then
+ echo "define(${2})" >> "${TMP_FILE}"
+ shift
+ else
+ SEEN_INPUT=1
+ sed -e '/^#/D' < "${1}" >> "${TMP_FILE}"
+ fi
+ shift
+ done
+ if [ ${SEEN_INPUT} -eq 0 ]; then
+ sed -e '/^#/D' >> "${TMP_FILE}"
+ fi
+ m4 < "${TMP_FILE}" | sed -e 's/@/$/g' -e 's/^\f$//'
+ rm -f "${TMP_FILE}"
+fi
--- /dev/null
+#| -*-Scheme-*-
+
+$Id: makegen.scm,v 1.2 2000/12/05 21:23:50 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+;;;; Generate "Makefile.in" from template.
+
+(declare (usual-integrations))
+
+(load-option 'REGULAR-EXPRESSION)
+(load-option 'SYNCHRONOUS-SUBPROCESS)
+\f
+(define (generate-makefile template deps-filename makefile)
+ (let ((file-lists
+ (map (lambda (pathname)
+ (cons (pathname-name pathname)
+ (read-file pathname)))
+ (list-transform-positive (directory-read "makegen/")
+ (lambda (pathname)
+ (re-string-match "^files-.+\\.scm$"
+ (file-namestring pathname)))))))
+ (call-with-input-file template
+ (lambda (input)
+ (call-with-output-file makefile
+ (lambda (output)
+ (write-string "# This file automatically generated from " output)
+ (write-string (file-namestring template) output)
+ (newline output)
+ (write-string "# on " output)
+ (write-string (universal-time->string (get-universal-time)) output)
+ (write-string "." output)
+ (newline output)
+ (newline output)
+ (let loop ((column 0))
+ (let ((char (read-char input)))
+ (if (not (eof-object? char))
+ (if (and (char=? #\@ char)
+ (eqv? #\( (peek-char input)))
+ (let ((command (read input)))
+ (if (eqv? #\@ (peek-char input))
+ (read-char input)
+ (error "Missing @ at end of command:" command))
+ (loop (interpret-command command column
+ file-lists deps-filename
+ output)))
+ (begin
+ (write-char char output)
+ (loop
+ (if (char=? #\newline char)
+ 0
+ (+ column 1))))))))))))))
+
+(define (interpret-command command column file-lists deps-filename output)
+ (let ((malformed (lambda () (error "Malformed command:" command))))
+ (if (not (and (pair? command)
+ (symbol? (car command))
+ (list? (cdr command))))
+ (malformed))
+ (let ((guarantee-nargs
+ (lambda (n)
+ (if (not (= n (length (cdr command))))
+ (malformed)))))
+ (let ((write-suffixed
+ (lambda (suffix)
+ (guarantee-nargs 1)
+ (let ((entry (assoc (cadr command) file-lists)))
+ (if (not entry)
+ (malformed))
+ (write-items (map (lambda (file) (string-append file suffix))
+ (cdr entry))
+ column
+ output)
+ 0))))
+ (case (car command)
+ ((WRITE-SOURCES)
+ (write-suffixed ".c"))
+ ((WRITE-OBJECTS)
+ (write-suffixed ".o"))
+ ((WRITE-DEPENDENCIES)
+ (guarantee-nargs 0)
+ (write-dependencies file-lists deps-filename output))
+ (else
+ (error "Unknown command:" command)))))))
+\f
+(define (write-dependencies file-lists deps-filename output)
+ (maybe-update-dependencies
+ deps-filename
+ (sort (append-map (lambda (file-list)
+ (map (lambda (base) (string-append base ".c"))
+ (cdr file-list)))
+ file-lists)
+ string<?))
+ (call-with-input-file deps-filename
+ (lambda (input)
+ (let ((buffer (make-string 4096)))
+ (let loop ()
+ (let ((n (read-substring! buffer 0 4096 input)))
+ (if (> n 0)
+ (begin
+ (write-substring buffer 0 n output)
+ (loop)))))))))
+
+(define (maybe-update-dependencies deps-filename source-files)
+ (if (let ((mtime (file-modification-time deps-filename)))
+ (or (not mtime)
+ (there-exists? source-files
+ (lambda (source-file)
+ (> (file-modification-time source-file) mtime)))))
+ (let ((rules (map generate-rule source-files)))
+ (call-with-output-file deps-filename
+ (lambda (output)
+ (let loop ((rules rules))
+ (if (pair? rules)
+ (begin
+ (write-rule (car rules) output)
+ (if (pair? (cdr rules))
+ (begin
+ (newline output)
+ (loop (cdr rules))))))))))))
+
+(define (generate-rule filename)
+ (parse-rule
+ (unbreak-lines
+ (with-string-output-port
+ (lambda (port)
+ (run-shell-command (string-append "gcc -M " filename)
+ 'OUTPUT port))))))
+
+(define (unbreak-lines string)
+ (let ((indexes (string-search-all "\\\n" string)))
+ (let ((n (length indexes))
+ (end (string-length string)))
+ (let ((result (make-string (- end (* 2 n)))))
+ (let loop ((start 0) (indexes indexes) (rstart 0))
+ (if (pair? indexes)
+ (begin
+ (substring-move! string start (car indexes) result rstart)
+ (loop (+ (car indexes) 2)
+ (cdr indexes)
+ (+ rstart (- (car indexes) start))))
+ (substring-move! string start end result rstart)))
+ result))))
+
+(define (parse-rule rule)
+ (let ((items (burst-string rule char-set:whitespace #t)))
+ (if (not (string-suffix? ":" (car items)))
+ (error "Missing rule target:" rule))
+ (cons* (string-head (car items) (- (string-length (car items)) 1))
+ (cadr items)
+ (sort (list-transform-negative (cddr items) pathname-absolute?)
+ string<?))))
+\f
+(define (write-rule rule port)
+ (write-string (car rule) port)
+ (write-string ": " port)
+ (write-items (cdr rule) (+ (string-length (car rule)) 2) port))
+
+(define (write-items items start-column port)
+ (let loop ((items* items) (column start-column))
+ (if (pair? items*)
+ (let ((column
+ (if (eq? items* items)
+ column
+ (begin
+ (write-string " " port)
+ (+ column 1))))
+ (delta (string-length (car items*))))
+ (let ((new-column (+ column delta)))
+ (if (>= new-column 78)
+ (begin
+ (write-string "\\\n\t" port)
+ (write-string (car items*) port)
+ (loop (cdr items*) (+ 8 delta)))
+ (begin
+ (write-string (car items*) port)
+ (loop (cdr items*) new-column)))))
+ column)))
\ No newline at end of file
--- /dev/null
+#!/bin/sh
+
+# $Id: makeinit.sh,v 1.2 2000/12/05 21:23:50 cph Exp $
+#
+# Copyright (c) 2000 Massachusetts Institute of Technology
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or (at
+# your option) any later version.
+#
+# 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, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+autoheader
+autoconf
+if [ ! -f Makefile.in ]; then
+ touch Makefile.in
+fi
+./configure
+scheme -heap 2000 <<EOF
+(load "makegen/makegen.scm")
+(generate-makefile "makegen/Makefile.in.in"
+ "makegen/Makefile.deps"
+ "Makefile.in")
+EOF
+./config.status
/* -*-C-*-
-$Id: memmag.c,v 9.65 1999/01/02 06:11:34 cph Exp $
+$Id: memmag.c,v 9.66 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
*/
#include "scheme.h"
-#include "memmag.h"
#include "prims.h"
+#include "memmag.h"
#include "gccode.h"
/* Imports */
return;
}
\f
-#ifdef WINNT
+#ifdef __WIN32__
static void
win32_flush_old_halfspace ()
if (win32_flush_old_halfspace_p)
win32_flush_old_halfspace ();
}
-#endif /* WINNT */
+#endif /* __WIN32__ */
DEFINE_PRIMITIVE ("WIN32-FLUSH-OLD-HALFSPACE-AFTER-GC?!", Prim_win32_flush_old_halfspace_after_gc, 1, 1,
"(boolean)")
{
PRIMITIVE_HEADER (1);
-#ifdef WINNT
+#ifdef __WIN32__
{
BOOL old = win32_flush_old_halfspace_p;
win32_flush_old_halfspace_p = (OBJECT_TO_BOOLEAN (ARG_REF (1)));
"()")
{
PRIMITIVE_HEADER (0);
-#ifdef WINNT
+#ifdef __WIN32__
win32_flush_old_halfspace ();
#else
error_unimplemented_primitive ();
COMPILER_TRANSPORT_END ();
-#ifdef WINNT
+#ifdef __WIN32__
{
extern void win32_advise_end_GC ();
win32_advise_end_GC ();
/* -*-C-*-
-$Id: memmag.h,v 1.7 1999/01/02 06:11:34 cph Exp $
+$Id: memmag.h,v 1.8 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#ifndef SCM_MEMMAG_H
#define SCM_MEMMAG_H
-#ifdef WINNT
+#ifdef __WIN32__
+ extern void win32_allocate_registers (void);
+ extern void win32_deallocate_registers (void);
+# define ALLOCATE_REGISTERS win32_allocate_registers
+# define DEALLOCATE_REGISTERS win32_deallocate_registers
-extern void winnt_allocate_registers (void);
-extern void winnt_deallocate_registers (void);
-#define ALLOCATE_REGISTERS winnt_allocate_registers
-#define DEALLOCATE_REGISTERS winnt_deallocate_registers
+# include "ntscmlib.h"
-#include "ntscmlib.h"
+ extern BOOL win32_under_win32s_p (void);
-extern BOOL win32_under_win32s_p (void);
-extern char * NT_allocate_heap (unsigned long, unsigned long *);
-extern void NT_release_heap (char *, unsigned long);
+ extern char * NT_allocate_heap (unsigned long, unsigned long *);
+ extern void NT_release_heap (char *, unsigned long);
+# define WIN32_ALLOCATE_HEAP NT_allocate_heap
+# define WIN32_RELEASE_HEAP NT_release_heap
-#ifdef WINNT_RAW_ADDRESSES
-
-#define WIN32_ALLOCATE_HEAP NT_allocate_heap
-#define WIN32_RELEASE_HEAP NT_release_heap
-
-#else /* not WINNT_RAW_ADDRESSES */
-
-extern unsigned long winnt_address_delta;
-extern unsigned short
- Scheme_Code_Segment_Selector,
- Scheme_Data_Segment_Selector,
- Scheme_Stack_Segment_Selector;
-
-unsigned long winnt_address_delta;
-static unsigned long total_fudge;
-
-#define SCM_FUDGE_1 0x1000L
-#define SCM_FUDGE_2 0x10000L
-
-static char *
-WIN32_ALLOCATE_HEAP (unsigned long size, unsigned long * handle)
-{
- unsigned long actual_size, actual_fudge_1, actual_fudge_2;
- char * base, * virtual_base;
-
- if (! (win32_under_win32s_p ()))
- {
- actual_fudge_1 = 0;
- actual_fudge_2 = 0;
- }
- else
- {
- actual_fudge_1 = SCM_FUDGE_1;
- actual_fudge_2 = SCM_FUDGE_2;
- }
- total_fudge = (actual_fudge_1 + actual_fudge_2);
- actual_size = (size + total_fudge);
-
- base = (NT_allocate_heap (actual_size, handle));
- if (base == ((char *) NULL))
- return (base);
-
- virtual_base = (base + total_fudge);
- winnt_address_delta = (((unsigned long) base) + actual_fudge_1);
- if (! (win32_system_utilities.alloc_scheme_selectors
- (winnt_address_delta,
- (size + actual_fudge_2),
- &Scheme_Code_Segment_Selector,
- &Scheme_Data_Segment_Selector,
- &Scheme_Stack_Segment_Selector)))
- /* Let the higher-level code fail. */
- winnt_address_delta = 0L;
-
- return (virtual_base);
-}
-\f
-static void
-WIN32_RELEASE_HEAP (char * area, unsigned long handle)
-{
- if (winnt_address_delta != 0)
- win32_system_utilities.release_scheme_selectors
- (Scheme_Code_Segment_Selector,
- Scheme_Data_Segment_Selector,
- Scheme_Stack_Segment_Selector);
- NT_release_heap ((area - total_fudge), handle);
-}
-
-#endif /* WINNT_RAW_ADDRESSES */
-
-static unsigned long scheme_heap_handle;
-
-#endif /* WINNT */
+ static unsigned long scheme_heap_handle;
+#endif
#ifndef HEAP_FREE
# define HEAP_FREE free
/* -*-C-*-
-$Id: missing.c,v 9.32 1999/01/02 06:11:34 cph Exp $
+$Id: missing.c,v 9.33 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
/* This file contains utilities potentially missing from the math library. */
-#include "oscond.h"
-#include "ansidecl.h"
#include "config.h"
\f
-#ifndef HAS_FREXP
+#ifndef HAVE_FREXP
double
DEFUN (frexp, (value, eptr),
return (x);
}
-#endif /* not HAS_FREXP */
+#endif /* not HAVE_FREXP */
\f
-#ifndef HAS_MODF
+#ifndef HAVE_MODF
double
DEFUN (modf, (value, iptr),
}
}
-#endif /* not HAS_MODF */
+#endif /* not HAVE_MODF */
\f
-#ifndef HAS_FLOOR
+#ifndef HAVE_FLOOR
double
DEFUN (floor, (x), double x)
return ((fraction > 0) ? (iptr + 1) : iptr);
}
-#endif /* not HAS_FLOOR */
+#endif /* not HAVE_FLOOR */
#ifdef DEBUG_MISSING
/* -*-C-*-
-$Id: mul.c,v 9.34 1999/01/02 06:06:43 cph Exp $
+$Id: mul.c,v 9.35 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
+#include "config.h"
+
/* This file contains the fixnum multiplication procedure. Returns
SHARP_F if the result does not fit in a fixnum. Note: The portable
version has only been tried on machines with long = 32 bits. This
#if (TYPE_CODE_LENGTH == 8)
-#if defined(vax) && defined(_BSD)
+#if defined(vax) && defined(__unix__)
#define MUL_HANDLED
: SHARP_F);
}
-#endif /* vax and _BSD */
+#endif /* vax and __unix__ */
\f
/* 68k family code. Uses hp9000s300 conventions for the new compiler. */
-#if defined(hp9000s300) && !defined(old_cc) && !defined(__GNUC__)
+#if (defined(hp9000s300) || defined(__hp9000s300)) && !defined(old_cc) && !defined(__GNUC__)
#define MUL_HANDLED
/* The following constants are hard coded in the assembly language
/* -*-C-*-
-$Id: nt.h,v 1.8 1999/01/02 06:11:34 cph Exp $
+$Id: nt.h,v 1.9 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#ifndef SCM_NT_H
#define SCM_NT_H
\f
-#define SYSTEM_NAME "NT"
-#define SYSTEM_VARIANT "Windows-NT"
-
#include <windows.h>
#include <sys/types.h>
#define EINTR 1999
#endif
-#include "oscond.h"
-#include "ansidecl.h"
-#include "posixtyp.h"
+#include "config.h"
#include "intext.h"
#include "dstack.h"
#define MAXPATHLEN 128
#endif
-#ifdef __STDC__
#define ALERT_CHAR '\a'
#define ALERT_STRING "\a"
-#else
-#define ALERT_CHAR '\007'
-#define ALERT_STRING "\007"
-#endif
#ifndef GUI
extern HANDLE STDIN_HANDLE, STDOUT_HANDLE, STDERR_HANDLE;
extern char * EXFUN (getlogin, (void));
#endif
-#ifndef WINNT
-extern PTR EXFUN (malloc, (unsigned int size));
-extern PTR EXFUN (realloc, (PTR ptr, unsigned int size));
-extern int EXFUN (gethostname, (char * name, unsigned int size));
-#endif
-
#ifdef _NFILE
#define NT_SC_OPEN_MAX() _NFILE
#else
/* -*-C-*-
-$Id: ntenv.c,v 1.18 1999/04/07 04:01:44 cph Exp $
+$Id: ntenv.c,v 1.19 2000/12/05 21:23:45 cph Exp $
Copyright (c) 1992-1999 Massachusetts Institute of Technology
return (file_time_to_unix_time (&ft));
}
+#if 0
static void
unix_time_to_system_time (unsigned long ut, SYSTEMTIME * st)
{
unix_time_to_file_time (ut, (&ft));
(void) FileTimeToSystemTime ((&ft), st);
}
+#endif
time_t
DEFUN_VOID (OS_encoded_time)
/* -*-C-*-
-$Id: ntfs.c,v 1.25 1999/12/21 18:48:25 cph Exp $
+$Id: ntfs.c,v 1.26 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "ntfs.h"
#include <string.h>
#include "outf.h"
+
+#ifndef FILE_TOUCH_OPEN_TRIES
+# define FILE_TOUCH_OPEN_TRIES 5
+#endif
\f
static enum get_file_info_result get_file_info_from_dir
(const char *, BY_HANDLE_FILE_INFORMATION *);
STD_BOOL_API_CALL (RemoveDirectory, (name));
}
\f
+static void EXFUN (protect_fd, (int fd));
+
+int
+OS_file_touch (const char * filename)
+{
+ int fd;
+ transaction_begin ();
+ {
+ unsigned int count = 0;
+ while (1)
+ {
+ count += 1;
+ /* Use O_EXCL to prevent overwriting existing file. */
+ fd = (open (filename, (O_RDWR | O_CREAT | O_EXCL), MODE_REG));
+ if (fd >= 0)
+ {
+ protect_fd (fd);
+ transaction_commit ();
+ return (1);
+ }
+ if (errno == EEXIST)
+ {
+ fd = (open (filename, O_RDWR, MODE_REG));
+ if (fd >= 0)
+ {
+ protect_fd (fd);
+ break;
+ }
+ else if (errno == ENOENT)
+ continue;
+ }
+ if (count >= FILE_TOUCH_OPEN_TRIES)
+ NT_error_unix_call (errno, syscall_open);
+ }
+ }
+ {
+ struct stat file_status;
+ STD_VOID_UNIX_CALL (fstat, (fd, (&file_status)));
+ if (((file_status . st_mode) & S_IFMT) != S_IFREG)
+ error_bad_range_arg (1);
+ /* CASE 3: file length of 0 needs special treatment. */
+ if ((file_status . st_size) == 0)
+ {
+ char buf [1];
+ (buf[0]) = '\0';
+ STD_VOID_UNIX_CALL (write, (fd, buf, 1));
+ transaction_commit ();
+ fd = (open (filename, (O_WRONLY | O_TRUNC), MODE_REG));
+ if (fd >= 0)
+ STD_VOID_UNIX_CALL (close, (fd));
+ return (0);
+ }
+ }
+ /* CASE 4: read, then write back the first byte in the file. */
+ {
+ char buf [1];
+ int scr;
+ STD_UINT_UNIX_CALL (scr, read, (fd, buf, 1));
+ if (scr > 0)
+ {
+ STD_VOID_UNIX_CALL (lseek, (fd, 0, SEEK_SET));
+ STD_VOID_UNIX_CALL (write, (fd, buf, 1));
+ }
+ }
+ transaction_commit ();
+ return (0);
+}
+
+static void
+DEFUN (protect_fd_close, (ap), PTR ap)
+{
+ close (* ((int *) ap));
+}
+
+static void
+DEFUN (protect_fd, (fd), int fd)
+{
+ int * p = (dstack_alloc (sizeof (int)));
+ (*p) = fd;
+ transaction_record_action (tat_always, protect_fd_close, p);
+}
+\f
typedef struct nt_dir_struct
{
WIN32_FIND_DATA entry;
/* -*-C-*-
-$Id: ntgui.c,v 1.27 2000/01/10 04:44:17 cph Exp $
+$Id: ntgui.c,v 1.28 2000/12/05 21:23:45 cph Exp $
Copyright (c) 1993-2000 Massachusetts Institute of Technology
static SCHEME_OBJECT parse_event (SCREEN_EVENT *);
-void *xmalloc(int);
-void xfree(void*);
-
int WINAPI
WinMain (HANDLE hInst, HANDLE hPrevInst, LPSTR lpCmdLine, int nCmdShow)
{
\f
extern HANDLE master_tty_window;
extern void catatonia_trigger (void);
-extern unsigned long * winnt_catatonia_block;
+extern unsigned long * win32_catatonia_block;
void
catatonia_trigger (void)
{
int mes_result;
static BOOL already_exitting = FALSE;
- SCHEME_OBJECT saved = winnt_catatonia_block[CATATONIA_BLOCK_LIMIT];
+ SCHEME_OBJECT saved = win32_catatonia_block[CATATONIA_BLOCK_LIMIT];
- winnt_catatonia_block[CATATONIA_BLOCK_LIMIT] = 0;
+ win32_catatonia_block[CATATONIA_BLOCK_LIMIT] = 0;
mes_result = (MessageBox (master_tty_window,
"Scheme appears to have become catatonic.\n"
"MIT Scheme",
(MB_ICONSTOP | MB_OKCANCEL)));
- winnt_catatonia_block[CATATONIA_BLOCK_COUNTER] = 0;
- winnt_catatonia_block[CATATONIA_BLOCK_LIMIT] = saved;
+ win32_catatonia_block[CATATONIA_BLOCK_COUNTER] = 0;
+ win32_catatonia_block[CATATONIA_BLOCK_LIMIT] = saved;
if (mes_result != IDOK)
return;
}
else
{
- winnt_catatonia_block[CATATONIA_BLOCK_COUNTER] = 0;
+ win32_catatonia_block[CATATONIA_BLOCK_COUNTER] = 0;
nt_gui_default_poll ();
#ifndef USE_WM_TIMER
low_level_timer_tick ();
long function_address;
SCHEME_OBJECT * argument_scan;
SCHEME_OBJECT * argument_limit;
- long result;
-
+ long result = UNSPECIFIC;
long nargs = (LEXPR_N_ARGUMENTS ());
if (nargs < 1)
signal_error_from_primitive (ERR_WRONG_NUMBER_OF_ARGUMENTS);
PRIMITIVE_RETURN (UNSPECIFIC);
}
\f
-static void *
-xmalloc (int size)
-{
- void *result = malloc(size);
- if (!result) {
- outf_fatal ("ntgui: xmalloc failed");
- outf_flush_fatal ();
- abort ();
- }
- return result;
-}
-
-static void
-xfree (void *p)
-{
- free (p);
-}
-\f
/* GUI utilities for debuggging .*/
#ifdef W32_TRAP_DEBUG
/* -*-C-*-
-$Id: ntio.c,v 1.22 1999/01/02 06:11:34 cph Exp $
+$Id: ntio.c,v 1.23 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
*/
#include "scheme.h"
+#include "prims.h"
#include "nt.h"
#include "ntio.h"
#include "osterm.h"
#include "osfile.h"
-#include "prims.h"
#include "outf.h"
#include "ossig.h"
#include "intrpt.h"
/* -*-C-*-
-$Id: ntscreen.c,v 1.45 2000/05/01 02:57:14 cph Exp $
+$Id: ntscreen.c,v 1.46 2000/12/05 21:23:45 cph Exp $
Copyright (c) 1993-2000 Massachusetts Institute of Technology
{
SCREEN screen = GETSCREEN (hWnd);
SCREEN_EVENT * event;
- unsigned int row;
- unsigned int column;
unsigned int control = 0;
unsigned int button = 0;
/* -*-C-*-
-$Id: ntsig.c,v 1.21 1999/01/02 06:11:34 cph Exp $
+$Id: ntsig.c,v 1.22 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#define TERMINATE_INTERRUPT_CHAR '@'
#define NO_INTERRUPT_CHAR '0'
-static void
-DEFUN (echo_keyboard_interrupt, (c, dc), cc_t c AND cc_t dc)
-{
- c &= 0177;
- if (c == ALERT_CHAR)
- outf_console ("%c", c);
- else if (c < '\040')
- outf_console ("^%c", (c+'@'));
- else if (c == '\177')
- outf_console ("^?");
- else
- outf_console ("%c", c);
- outf_flush_console ();
-}
-
/* Keyboard interrupt */
#define KB_INT_TABLE_SIZE ((256) + 1)
#define ASYNC_TIMER_PERIOD 50 /* msec */
static void * timer_state = ((void *) NULL);
-extern unsigned long * winnt_catatonia_block;
+extern unsigned long * win32_catatonia_block;
static char *
DEFUN_VOID (install_timer)
*/
long catatonia_offset
- = (((SCHEME_OBJECT *) &winnt_catatonia_block[0]) - (&Registers[0]));
+ = (((SCHEME_OBJECT *) &win32_catatonia_block[0]) - (&Registers[0]));
- winnt_catatonia_block[CATATONIA_BLOCK_COUNTER] = 0;
- winnt_catatonia_block[CATATONIA_BLOCK_LIMIT]
+ win32_catatonia_block[CATATONIA_BLOCK_COUNTER] = 0;
+ win32_catatonia_block[CATATONIA_BLOCK_LIMIT]
= (CATATONIA_PERIOD / ASYNC_TIMER_PERIOD);
- winnt_catatonia_block[CATATONIA_BLOCK_FLAG] = 0;
+ win32_catatonia_block[CATATONIA_BLOCK_FLAG] = 0;
switch (win32_system_utilities.install_async_timer
(&timer_state,
&Registers[0],
/* -*-C-*-
-$Id: nttop.c,v 1.29 1999/01/02 06:11:34 cph Exp $
+$Id: nttop.c,v 1.30 2000/12/05 21:23:45 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
NT_initialize_processes ();
NT_initialize_sockets ();
- OS_Name = SYSTEM_NAME;
+ OS_Name = "NT";
{
OSVERSIONINFO info;
char * p = (malloc (250));
/* -*-C-*-
-$Id: nttrap.c,v 1.17 1999/01/02 06:11:34 cph Exp $
+$Id: nttrap.c,v 1.18 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
extern int EXFUN (TellUserEx, (int, char *, ...));
#endif /* W32_TRAP_DEBUG */
+extern void EXFUN (callWinntExceptionTransferHook, (void));
extern void EXFUN (NT_initialize_traps, (void));
extern void EXFUN (NT_restore_traps, (void));
-#ifndef WINNT_RAW_ADDRESSES
-extern unsigned short
- Scheme_Code_Segment_Selector,
- Scheme_Data_Segment_Selector,
- Scheme_Stack_Segment_Selector,
- C_Code_Segment_Selector,
- C_Data_Segment_Selector,
- C_Extra_Segment_Selector,
- C_Stack_Segment_Selector;
-#endif
-
extern DWORD
C_Stack_Pointer,
C_Frame_Pointer;
bufptr += (sprintf (bufptr, "\ncontext->Eip = 0x%lx.", context->Eip));
bufptr += (sprintf (bufptr, "\ncontext->Esp = 0x%lx.", context->Esp));
bufptr += (sprintf (bufptr, "\nStack_Pointer = 0x%lx.", Stack_Pointer));
-#ifndef WINNT_RAW_ADDRESSES
- bufptr += (sprintf (bufptr, "\nwinnt_address_delta = 0x%lx.", winnt_address_delta));
-#endif
bufptr += (sprintf (bufptr, "\nadj (Stack_Pointer) = 0x%lx.",
(ADDR_TO_SCHEME_ADDR (Stack_Pointer))));
-#ifndef WINNT_RAW_ADDRESSES
- bufptr += (sprintf (bufptr, "\nCS = 0x%04x;\tC CS = 0x%04x;\tS CS = 0x%04x.",
- context->SegCs,
- C_Code_Segment_Selector,
- Scheme_Code_Segment_Selector));
-
- bufptr += (sprintf (bufptr, "\nDS = 0x%04x;\tC DS = 0x%04x;\tS DS = 0x%04x.",
- context->SegDs,
- C_Data_Segment_Selector,
- Scheme_Data_Segment_Selector));
-
- bufptr += (sprintf (bufptr, "\nES = 0x%04x;\tC ES = 0x%04x;\tS ES = 0x%04x.",
- context->SegEs,
- C_Extra_Segment_Selector,
- C_Data_Segment_Selector));
-
- bufptr += (sprintf (bufptr, "\nSS = 0x%04x;\tC SS = 0x%04x;\tS SS = 0x%04x.",
- context->SegSs,
- C_Stack_Segment_Selector,
- Scheme_Stack_Segment_Selector));
-#endif
}
#endif /* W32_TRAP_DEBUG */
* real_stack_guard,
* real_stack_pointer;
-extern int EXFUN (WinntExceptionTransferHook, (void));
-extern void EXFUN (callWinntExceptionTransferHook, (void));
-
int
-DEFUN_VOID (WinntExceptionTransferHook)
+WinntExceptionTransferHook (void)
{
/* These must be static because the memcpy below may
be overwriting this procedure's locals!
static SCHEME_OBJECT * EXFUN
(find_block_address, (char * pc_value, SCHEME_OBJECT * area_start));
-#define I386_NREGS 12
+#define IA32_NREGS 12
/* For now */
#define GET_ETEXT() (Heap_Bottom)
Stack_Pointer, context->Esp));
scheme_sp = (context->Esp);
}
-#ifndef WINNT_RAW_ADDRESSES
- else if (context->SegSs == Scheme_Stack_Segment_Selector)
- {
- IFVERBOSE (TellUserEx (MB_OKCANCEL,
- "continue_from_trap: SS = Scheme SS."));
- scheme_sp = ((long) (SCHEME_ADDR_TO_ADDR (context->Esp)));
- }
-#endif
else
{
IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: SS unknown!"));
IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: CS = C CS."));
the_pc = (context->Eip & PC_VALUE_MASK);
}
-#ifndef WINNT_RAW_ADDRESSES
- else if (context->SegCs == Scheme_Code_Segment_Selector)
- {
- IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: CS = Scheme CS"));
- /* Assume in Scheme. Of course, it could be in a builtin. */
- the_pc = ((long) (SCHEME_ADDR_TO_ADDR (context->Eip & PC_VALUE_MASK)));
- }
-#endif
else
{
IFVERBOSE (TellUserEx (MB_OKCANCEL, "continue_from_trap: CS unknown"));
}
else
{
- long primitive_address =
- ((long) (Primitive_Procedure_Table[OBJECT_DATUM (primitive)]));
(trinfo . state) = STATE_PRIMITIVE;
(trinfo . pc_info_1) = primitive;
(trinfo . pc_info_2) =
else
{
xtra_info = Free;
- Free += (1 + (I386_NREGS + 2));
+ Free += (1 + (IA32_NREGS + 2));
(trinfo . extra_trap_info) =
(MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, xtra_info));
- (*xtra_info++) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (I386_NREGS + 2)));
+ (*xtra_info++) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (IA32_NREGS + 2)));
(*xtra_info++) = ((SCHEME_OBJECT) the_pc);
(*xtra_info++) = ((SCHEME_OBJECT) scheme_sp);
{
- int counter = I386_NREGS;
+ int counter = IA32_NREGS;
int * regs = ((int *) context->Edi);
while ((counter--) > 0)
(*xtra_info++) = ((SCHEME_OBJECT) (*regs++));
if (pc_in_scheme && (! (win32_under_win32s_p ())))
{
-#ifndef WINNT_RAW_ADDRESSES
- context->SegCs = C_Code_Segment_Selector;
- context->SegDs = C_Data_Segment_Selector;
- context->SegEs = C_Extra_Segment_Selector;
- context->SegSs = C_Stack_Segment_Selector;
-#endif
context->Esp = C_Stack_Pointer;
context->Ebp = C_Frame_Pointer;
if (pc_in_scheme)
# define PAGE_SIZE 0x1000
#endif
-extern void EXFUN (winnt_stack_reset, (void));
-extern void EXFUN (winnt_protect_stack, (void));
-extern void EXFUN (winnt_unprotect_stack, (void));
-
static Boolean stack_protected = FALSE;
unsigned long protected_stack_base;
unsigned long protected_stack_end;
void
-DEFUN_VOID (winnt_unprotect_stack)
+DEFUN_VOID (win32_unprotect_stack)
{
DWORD old_protection;
}
void
-DEFUN_VOID (winnt_protect_stack)
+DEFUN_VOID (win32_protect_stack)
{
DWORD old_protection;
}
void
-DEFUN_VOID (winnt_stack_reset)
+DEFUN_VOID (win32_stack_reset)
{
unsigned long boundary;
- (2 * PAGE_SIZE));
if (stack_protected && (protected_stack_base == boundary))
return;
- winnt_unprotect_stack ();
+ win32_unprotect_stack ();
protected_stack_base = boundary;
protected_stack_end = (boundary + PAGE_SIZE);
- winnt_protect_stack ();
+ win32_protect_stack ();
return;
}
\f
}
#endif /* USE_SET_UNHANDLED_EXCEPTION_FILTER */
-extern void EXFUN (WinntEnterHook, (void (*) (void)));
-
void
-DEFUN (WinntEnterHook, (enter_interpreter),
- void EXFUN ((* enter_interpreter), (void)))
+win32_enter_interpreter (void (*enter_interpreter) (void))
{
#ifdef USE_SET_UNHANDLED_EXCEPTION_FILTER
(void) SetUnhandledExceptionFilter (scheme_unhandled_exception_filter);
/* -*-C-*-
-$Id: nttterm.c,v 1.3 1999/01/02 06:11:34 cph Exp $
+$Id: nttterm.c,v 1.4 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
-/* termcap(3) interface for Scheme -- Only a subset needed for DOS. */
+/* termcap(3) interface for Scheme -- Only a subset needed for Win32. */
#include "scheme.h"
#include "prims.h"
--- /dev/null
+/* -*-C-*-
+
+$Id: config.h,v 1.2 2000/12/05 21:23:50 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*/
+
+#ifndef SCM_CONFIG_H
+#define SCM_CONFIG_H
+
+#ifndef __WIN32__
+# define __WIN32__
+#endif
+
+#if defined(_MSC_VER) && !defined(CL386)
+# define CL386
+#endif
+
+#include <sys/types.h>
+#include <time.h>
+
+#ifdef CL386
+typedef _off_t off_t;
+#else
+typedef short nlink_t;
+#endif
+
+typedef unsigned short mode_t;
+typedef unsigned long pid_t;
+typedef short uid_t;
+typedef short gid_t;
+typedef unsigned char cc_t;
+typedef long ssize_t;
+
+/* The number of bytes in a unsigned long. */
+#define SIZEOF_UNSIGNED_LONG 4
+
+/* Define if your processor stores words with the most significant
+ byte first (like Motorola and SPARC, unlike Intel and VAX). */
+#undef WORDS_BIGENDIAN
+
+/* Define if you have the floor function. */
+#define HAVE_FLOOR 1
+
+/* Define if you have the frexp function. */
+#define HAVE_FREXP 1
+
+/* Define if you have the modf function. */
+#define HAVE_MODF 1
+
+/* Define if you have the ANSI C header files. */
+#define STDC_HEADERS 1
+
+/* Define if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
+
+/* Define if architecture has native-code compiler support. */
+#define HAS_COMPILER_SUPPORT 1
+
+/* Include the shared configuration header. */
+#include "confshared.h"
+
+#endif /* SCM_CONFIG_H */
### -*- Fundamental -*-
###
-### $Id: makefile.wcc,v 1.15 2000/12/03 05:43:40 cph Exp $
+### $Id: makefile.wcc,v 1.16 2000/12/05 21:23:51 cph Exp $
###
### Copyright (c) 1992-2000 Massachusetts Institute of Technology
###
all : scheme.exe bchschem.exe bintopsb.exe psbtobin.exe
-.c.obj :
+.c.obj:
$(CC) $(CFLAGS) $[@
-.asm.obj :
+.asm.obj:
$(AS) $(ASFLAGS) /fo=$^@ $[@
CORE_SOURCES = &
nttty.c &
ntasutl.asm
-HEAD_FILES = scheme.tch prims.h zones.h locks.h bignum.h &
- $(GC_HEAD_FILES) trap.h lookup.h history.h cmpint.h
-
-GC_HEAD_FILES = gccode.h cmpgc.h ntscmlib.h cmpintmd.h
-
CORE_OBJECTS = &
artutl.obj &
avltree.obj &
scheme : scheme.exe .SYMBOLIC
clean : .SYMBOLIC
- -del *.tch
-del *.obj
-del *.exe
-del *.lib
-del *.rc
-del *.cur
-primitive_tables : .SYMBOLIC
- -del usrdef.c
- -del usrdef.obj
- -del bchdef.c
- -del bchdef.obj
-
scheme.exe : $(OBJECTS) $(SCHEME_OBJECTS) scheme32.obj ntgui.res
*wlink system nt_win name $^@ $(LDFLAGS) &
file { $(OBJECTS) $(SCHEME_OBJECTS) scheme32.obj } &
ntgui.res : ntgui.rc ntgui.h ntdialog.dlg ntdialog.h
wrc /q /ad /bt=nt /r /x /D__WATCOMC__ $(WRCFLAGS_SYSTEM) $[@
-usrdef.c : $(SCHEME_SOURCES) $(SOURCES) $(OS_PRIM_SOURCES) ntgui.c usrdef.tch &
+usrdef.c : $(SCHEME_SOURCES) $(SOURCES) $(OS_PRIM_SOURCES) ntgui.c &
findprim.exe
.\findprim $(SCHEME_SOURCES) $(SOURCES) $(OS_PRIM_SOURCES) ntgui.c &
> $^@
bchdef.c : $(SCHEME_SOURCES) $(BCHSOURCES) $(OS_PRIM_SOURCES) ntgui.c &
- usrdef.tch findprim.exe
+ findprim.exe
.\findprim $(SCHEME_SOURCES) $(BCHSOURCES) $(OS_PRIM_SOURCES) ntgui.c &
> $^@
-scheme.tch : scheme.h oscond.h ansidecl.h dstack.h obstack.h config.h &
- bkpt.h object.h scode.h sdata.h gc.h interp.h stack.h futures.h &
- types.h errors.h returns.h const.h fixobj.h default.h extern.h &
- prim.h intrpt.h critsec.h float.h outf.h
- wtouch /q /r $^@
-
-psbmap.tch : config.h object.h bignum.h bignmint.h bitstr.h types.h &
- sdata.h const.h psbmap.h $(GC_HEAD_FILES) comlin.h comlin.c
- wtouch /q /r $^@
-
-usrdef.tch : usrdef.h config.h object.h prim.h
- wtouch /q /r $^@
-
-foo $(USER_PRIM_OBJECTS) : $(HEAD_FILES)
-
-### files compiled with optimization
-interp.obj : scheme.tch locks.h trap.h lookup.h history.h cmpint.h zones.h &
- prmcon.h
-
-ntscreen.obj : ntscreen.c ntgui.h ntscreen.h
-
-gcloop.obj : scheme.tch $(GC_HEAD_FILES)
-
-fasload.obj : scheme.tch prims.h osscheme.h osfile.h osio.h $(GC_HEAD_FILES) &
- trap.h option.h prmcon.h load.c fasl.h
-
-hooks.obj : scheme.tch prims.h winder.h history.h
-utils.obj : scheme.tch prims.h winder.h history.h cmpint.h syscall.h ntapi.h
-primutl.obj : scheme.tch os.h prims.h usrdef.h prename.h syscall.h ntapi.h &
- avltree.h $(GC_HEAD_FILES)
-hunk.obj list.obj step.obj vector.obj : scheme.tch prims.h
-sysprim.obj daemon.obj prim.obj extern.obj : scheme.tch prims.h
-lookup.obj debug.obj intern.obj : scheme.tch prims.h lookup.h trap.h locks.h
-fasdump.obj : scheme.tch prims.h osio.h osfile.h osfs.h $(GC_HEAD_FILES) &
- trap.h lookup.h fasl.h dump.c
-memmag.obj : scheme.tch prims.h $(GC_HEAD_FILES) memmag.h
-purify.obj : scheme.tch prims.h $(GC_HEAD_FILES) zones.h
-wabbit.obj : scheme.tch $(GC_HEAD_FILES)
-purutl.obj : scheme.tch prims.h $(GC_HEAD_FILES) zones.h
-comutl.obj : scheme.tch prims.h
-artutl.obj : scheme.tch
-avltree.obj : ansidecl.h avltree.h
-bignum.obj : scheme.tch bignmint.h limits.h
-bigprm.obj flonum.obj intprm.obj : scheme.tch prims.h zones.h
-generic.obj : scheme.tch prims.h
-fixnum.obj : scheme.tch prims.h mul.c
-storage.obj : scheme.tch gctype.c
-char.obj string.obj dfloat.obj : scheme.tch prims.h
-nttterm.obj : scheme.tch prims.h osterm.h
-boot.obj : scheme.tch prims.h version.h option.h ostop.h
-option.obj : scheme.tch fasl.h osenv.h osfs.h
-term.obj : scheme.tch
-missing.obj : config.h
-BCHGCC_H = bchgcc.h oscond.h $(GC_HEAD_FILES)
-bchdmp.obj : bchdmp.c scheme.tch prims.h ntio.h osio.h osfile.h trap.h &
- lookup.h $(BCHGCC_H) fasl.h dump.c
-bchdrn.obj : bchdrn.c ansidecl.h bchdrn.h
-bchmmg.obj : bchmmg.c scheme.tch prims.h nt.h $(BCHGCC_H) option.h bchdrn.h &
- memmag.h
-bchgcl.obj : bchgcl.c scheme.tch $(BCHGCC_H)
-bchpur.obj : bchpur.c scheme.tch prims.h $(BCHGCC_H) zones.h
-bchutl.obj : bchutl.c ansidecl.h
-syntax.obj : syntax.c scheme.tch prims.h edwin.h syntax.h
-bitstr.obj : bitstr.c scheme.tch prims.h bitstr.h
-regex.obj : regex.c scheme.tch syntax.h regex.h
-rgxprim.obj : rgxprim.c scheme.tch prims.h edwin.h syntax.h regex.h
-bintopsb.obj : bintopsb.c psbmap.tch trap.h limits.h fasl.h load.c bltdef.h
-psbtobin.obj : psbtobin.c psbmap.tch float.h fasl.h dump.c
-ppband.obj : ppband.c ansidecl.h config.h errors.h types.h const.h object.h &
- $(GC_HEAD_FILES) sdata.h load.c fasl.h
-outf.obj : outf.c scheme.tch ntscreen.h
-
-fft.obj : fft.c scheme.tch prims.h zones.h array.h image.h
-array.obj image.obj : scheme.tch prims.h array.h
-cmpint.obj : cmpint.c scheme.tch prim.h $(GC_HEAD_FILES)
-osscheme.obj : osscheme.c scheme.tch posixtyp.h os.h osscheme.h
-ostty.obj : ostty.c ansidecl.h oscond.h posixtyp.h os.h ostty.h osscheme.h
-error.obj ptrvec.obj transact.obj : ansidecl.h dstack.h outf.h
-wind.obj : wind.c ansidecl.h dstack.h obstack.h
-obstack.obj : obstack.c obstack.h
-
-OS_PRIM_DEPENDENCIES = scheme.tch prims.h posixtyp.h os.h
-prbfish.obj : prbfish.c $(OS_PRIM_DEPENDENCIES)
-prgdbm.obj : prgdbm.c $(OS_PRIM_DEPENDENCIES)
-prmd5.obj : prmd5.c $(OS_PRIM_DEPENDENCIES)
-prosenv.obj : prosenv.c osenv.h ostop.h $(OS_PRIM_DEPENDENCIES)
-prosfile.obj : prosfile.c osfile.h $(OS_PRIM_DEPENDENCIES)
-prosfs.obj : prosfs.c osfs.h $(OS_PRIM_DEPENDENCIES)
-prosio.obj : prosio.c osio.h $(OS_PRIM_DEPENDENCIES)
-prosproc.obj : prosproc.c osproc.h $(OS_PRIM_DEPENDENCIES)
-prosterm.obj : prosterm.c osterm.h osio.h $(OS_PRIM_DEPENDENCIES)
-prostty.obj : prostty.c ostty.h osctty.h ossig.h osfile.h osio.h &
- $(OS_PRIM_DEPENDENCIES)
-pruxsock.obj : $(OS_PRIM_DEPENDENCIES)
-prmcon.obj : prmcon.c scheme.tch prims.h prmcon.h $(OS_PRIM_DEPENDENCIES)
-
-NT_DEPENDENCIES = oscond.h ansidecl.h posixtyp.h intext.h &
- dstack.h os.h osscheme.h nt.h ntapi.h ntsys.h syscall.h
-ntenv.obj : ntenv.c scheme.tch osenv.h ntscreen.h $(NT_DEPENDENCIES)
-ntfile.obj : ntfile.c osfile.h osio.h ntio.h $(NT_DEPENDENCIES)
-ntfs.obj : ntfs.c ntfs.h osfs.h $(NT_DEPENDENCIES)
-ntio.obj : ntio.c osio.h ntio.h ntscreen.h $(NT_DEPENDENCIES)
-ntproc.obj : ntproc.c $(NT_DEPENDENCIES) osproc.h ntproc.h osio.h ntio.h &
- ntscreen.h ntgui.h
-nttop.obj : nttop.c ostop.h nttop.h osctty.h errors.h option.h &
- $(NT_DEPENDENCIES)
-nttty.obj : nttty.c ostty.h osenv.h osio.h ntio.h osterm.h ntterm.h &
- ntscreen.h $(NT_DEPENDENCIES)
-ntsig.obj : ntsig.c ossig.h osctty.h ostty.h critsec.h &
- $(NT_DEPENDENCIES) ntgui.h ntio.h ntscmlib.h ntscreen.h
-ntsock.obj : ntsock.c ntio.h osio.h uxsock.h $(NT_DEPENDENCIES)
-nttrap.obj: nttrap.c nttrap.h ntscmlib.h $(GC_HEAD_FILES) $(NT_DEPENDENCIES)
-ntsys.obj: ntsys.c ntsys.h
-ntgui.obj : ntgui.c ntdialog.h ntgui.h ntscreen.h $(NT_DEPENDENCIES) scheme.tch
-ntasutl.obj : ntasutl.asm
-ntkbutl.obj : ntkbutl.asm
-prntenv.obj : prntenv.c $(NT_DEPENDENCIES)
-prntfs.obj : prntfs.c ntfs.h $(NT_DEPENDENCIES) scheme.tch prims.h osfs.h
-prntio.obj : prntio.c $(NT_DEPENDENCIES) scheme.tch prims.h ntio.h osio.h &
- syscall.h ntscreen.h ntgui.h
-
-cmpauxmd.obj : cmpauxmd.asm
-
-#ntscmlib.dll ntscmlib.lib : ntwntlib.dll ntw32lib.dll
-# copy ntw32lib.dll ntscmlib.dll
-# copy ntw32lib.lib ntscmlib.lib
-#
-#ntwntlib.dll : ntwntlib.obj ntscmlib.lnk
-# wlink @ntscmlib.lnk option quiet file { ntwntlib.obj }
#
-#ntwntlib.lib : ntwntlib.dll
-# wlib /b /c /n /q $^@ +$[@
+# Dependencies. (This was a lot of work!)
#
-#ntwntlib.obj : ntwntlib.c ntscmlib.h
-# $(CC) $(CFLAGS) /bd $[@
+# This first section defines the dependencies of the include files.
#
-#ntw32lib.dll ntw32lib.lib : ntw32lib.obj ntscmlib.lnk
-# wlink @ntscmlib.lnk option quiet file { ntw32lib.obj }
+AVLTREE_H = avltree.h $(CONFIG_H)
+BCHDRN_H = bchdrn.h $(CONFIG_H)
+BCHGCC_H = bchgcc.h $(CONFIG_H) $(GCCODE_H)
+BIGNMINT_H = bignmint.h $(PRIMS_H)
+BIGNUM_H = bignum.h ansidecl.h
+BITSTR_H = bitstr.h
+BKPT_H = bkpt.h
+CMPGC_H = cmpgc.h $(CMPINTMD_H)
+CMPINTMD_H = cmpintmd.h $(CMPTYPE_H)
+CMPINT_H = cmpint.h
+CMPTYPE_H = cmptype.h
+COMLIN_H = comlin.h ansidecl.h
+CONFIG_H = config.h confshared.h ansidecl.h
+CONST_H = const.h
+CRITSEC_H = critsec.h
+DEFAULT_H = default.h
+DSTACK_H = dstack.h ansidecl.h
+DUMP_C = dump.c
+EDWIN_H = edwin.h
+ERRORS_H = errors.h
+EXTERN_H = extern.h
+FASL_H = fasl.h
+FIXOBJ_H = fixobj.h
+FLOAT_H = float.h
+FUTURES_H = futures.h
+GCCODE_H = gccode.h $(CMPGC_H)
+GCTYPE_C = gctype.c $(CONFIG_H)
+GC_H = gc.h
+HISTORY_H = history.h
+INTERP_H = interp.h
+INTEXT_H = intext.h ansidecl.h $(DSTACK_H)
+INTRPT_H = intrpt.h
+LIMITS_H = limits.h
+LOAD_C = load.c $(FASL_H)
+LOCKS_H = locks.h
+LOOKUP_H = lookup.h
+MEMMAG_H = memmag.h $(NTSCMLIB_H)
+MUL_C = mul.c $(CONFIG_H)
+NTAPI_H = ntapi.h
+NTDIALOG_H = ntdialog.h
+NTGUI_H = ntgui.h
+NTIO_H = ntio.h $(OSIO_H)
+NTSCMLIB_H = ntscmlib.h
+NTSCREEN_H = ntscreen.h
+NTSYS_H = ntsys.h
+NTTERM_H = ntterm.h $(OSTERM_H)
+NTTOP_H = nttop.h $(OSTOP_H)
+NTTRAP_H = nttrap.h
+OBJECT_H = object.h
+OBSTACK_H = obstack.h $(CONFIG_H)
+OPTION_H = option.h ansidecl.h
+OSCTTY_H = osctty.h $(OS_H)
+OSENV_H = osenv.h $(OS_H)
+OSFILE_H = osfile.h $(OS_H)
+OSFS_H = osfs.h $(OS_H)
+OSIO_H = osio.h $(OS_H)
+OSSCHEME_H = osscheme.h $(OUTF_H) $(OS_H)
+OSSIG_H = ossig.h $(OS_H)
+OSTERM_H = osterm.h $(OS_H)
+OSTOP_H = ostop.h $(OS_H)
+OSTTY_H = ostty.h $(OS_H)
+OS_H = os.h $(CONFIG_H)
+OUTF_H = outf.h $(CONFIG_H)
+PRENAME_H = prename.h
+PRIMS_H = prims.h ansidecl.h
+PRIM_H = prim.h
+PRMCON_H = prmcon.h
+REGEX_H = regex.h
+RETURNS_H = returns.h
+SCODE_H = scode.h
+SDATA_H = sdata.h
+STACK_H = stack.h
+SYNTAX_H = syntax.h
+SYSCALL_H = syscall.h $(CONFIG_H) $(NTAPI_H)
+TRAP_H = trap.h
+TYPES_H = types.h
+USRDEF_H = usrdef.h $(SCHEME_H) $(PRIMS_H)
+UXSOCK_H = uxsock.h $(OSIO_H)
+VERSION_H = version.h
+WINDER_H = winder.h
+ZONES_H = zones.h
+
+PSBMAP_H = psbmap.h $(CONFIG_H) $(TYPES_H) $(OBJECT_H) $(BIGNUM_H) &
+ $(BIGNMINT_H) $(SDATA_H) $(CONST_H) $(GCCODE_H) $(CMPTYPE_H) &
+ $(COMLIN_H)
+
+NT_H = nt.h $(CONFIG_H) $(INTEXT_H) $(DSTACK_H) $(OSSCHEME_H) $(NTSYS_H) &
+ $(SYSCALL_H) $(NTAPI_H)
+
+SCHEME_H = scheme.h $(CONFIG_H) $(DSTACK_H) $(OBSTACK_H) $(TYPES_H) &
+ $(CONST_H) $(OBJECT_H) $(INTRPT_H) $(CRITSEC_H) $(GC_H) $(SCODE_H) &
+ $(SDATA_H) $(FUTURES_H) $(ERRORS_H) $(RETURNS_H) $(FIXOBJ_H) &
+ $(STACK_H) $(INTERP_H) $(OUTF_H) $(BKPT_H) $(DEFAULT_H) $(EXTERN_H) &
+ $(BIGNUM_H) $(PRIM_H) $(FLOAT_H)
+
#
-#ntw32lib.lib : ntw32lib.dll
-# wlib /b /c /n /q $^@ +$[@
+# This second section is the dependencies of the object files.
#
-#ntw32lib.obj : ntw32lib.c ntscmlib.h
-# $(CC) $(CFLAGS) /bd $[@
+artutl.obj: artutl.c $(SCHEME_H) $(LIMITS_H)
+avltree.obj: avltree.c $(AVLTREE_H)
+bignum.obj: bignum.c $(SCHEME_H) $(BIGNMINT_H) $(LIMITS_H)
+bigprm.obj: bigprm.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
+bitstr.obj: bitstr.c $(SCHEME_H) $(PRIMS_H) $(BITSTR_H)
+boot.obj: boot.c $(SCHEME_H) $(PRIMS_H) $(VERSION_H) $(OPTION_H) $(OSTOP_H) &
+ $(OSTTY_H)
+char.obj: char.c $(SCHEME_H) $(PRIMS_H)
+cmpauxmd.obj: cmpauxmd.asm
+cmpint.obj: cmpint.c $(CONFIG_H) $(DSTACK_H) $(OUTF_H) $(TYPES_H) $(CONST_H) &
+ $(OBJECT_H) $(INTRPT_H) $(GC_H) $(SDATA_H) $(ERRORS_H) $(RETURNS_H) &
+ $(FIXOBJ_H) $(STACK_H) $(INTERP_H) $(DEFAULT_H) $(EXTERN_H) $(TRAP_H) &
+ $(PRIMS_H) $(PRIM_H) $(CMPGC_H) $(NTSCMLIB_H)
+comutl.obj: comutl.c $(SCHEME_H) $(PRIMS_H)
+daemon.obj: daemon.c $(SCHEME_H) $(PRIMS_H) $(OSIO_H)
+debug.obj: debug.c $(SCHEME_H) $(PRIMS_H) $(TRAP_H) $(LOOKUP_H)
+dfloat.obj: dfloat.c $(SCHEME_H) $(PRIMS_H)
+error.obj: error.c $(OUTF_H) $(DSTACK_H)
+extern.obj: extern.c $(SCHEME_H) $(PRIMS_H)
+fasload.obj: fasload.c $(SCHEME_H) $(PRIMS_H) $(OSSCHEME_H) $(OSFILE_H) &
+ $(OSIO_H) $(GCCODE_H) $(TRAP_H) $(OPTION_H) $(PRMCON_H)
+fixnum.obj: fixnum.c $(SCHEME_H) $(PRIMS_H) $(MUL_C)
+flonum.obj: flonum.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
+generic.obj: generic.c $(SCHEME_H) $(PRIMS_H)
+hooks.obj: hooks.c $(SCHEME_H) $(PRIMS_H) $(WINDER_H) $(HISTORY_H)
+hunk.obj: hunk.c $(SCHEME_H) $(PRIMS_H)
+intern.obj: intern.c $(SCHEME_H) $(PRIMS_H) $(TRAP_H)
+interp.obj: interp.c $(SCHEME_H) $(LOCKS_H) $(TRAP_H) $(LOOKUP_H) $(WINDER_H) &
+ $(HISTORY_H) $(CMPINT_H) $(ZONES_H) $(PRMCON_H)
+intprm.obj: intprm.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
+list.obj: list.c $(SCHEME_H) $(PRIMS_H)
+lookprm.obj: lookprm.c $(SCHEME_H) $(PRIMS_H) $(LOCKS_H) $(TRAP_H) $(LOOKUP_H)
+lookup.obj: lookup.c $(SCHEME_H) $(LOCKS_H) $(TRAP_H) $(LOOKUP_H)
+obstack.obj: obstack.c $(OBSTACK_H)
+option.obj: option.c $(SCHEME_H) $(FASL_H) $(OSENV_H) $(OSFS_H) $(NT_H) &
+ $(NTIO_H)
+osscheme.obj: osscheme.c $(SCHEME_H) $(PRIMS_H) $(OSSCHEME_H)
+ostty.obj: ostty.c $(OSTTY_H) $(OSSCHEME_H)
+outf.obj: outf.c $(SCHEME_H) $(NTSCREEN_H)
+prim.obj: prim.c $(SCHEME_H) $(PRIMS_H)
+primutl.obj: primutl.c $(SCHEME_H) $(PRIMS_H) $(OS_H) $(USRDEF_H) &
+ $(PRENAME_H) $(SYSCALL_H) $(AVLTREE_H) $(CMPGC_H)
+prmcon.obj: prmcon.c $(SCHEME_H) $(PRIMS_H) $(PRMCON_H)
+ptrvec.obj: ptrvec.c $(OUTF_H) $(DSTACK_H)
+purutl.obj: purutl.c $(SCHEME_H) $(PRIMS_H) $(GCCODE_H) $(ZONES_H) &
+ $(CMPINT_H)
+regex.obj: regex.c $(SCHEME_H) $(SYNTAX_H) $(REGEX_H)
+rgxprim.obj: rgxprim.c $(SCHEME_H) $(PRIMS_H) $(EDWIN_H) $(SYNTAX_H) $(REGEX_H)
+step.obj: step.c $(SCHEME_H) $(PRIMS_H)
+storage.obj: storage.c $(SCHEME_H) $(GCTYPE_H)
+string.obj: string.c $(SCHEME_H) $(PRIMS_H)
+syntax.obj: syntax.c $(SCHEME_H) $(PRIMS_H) $(EDWIN_H) $(SYNTAX_H)
+sysprim.obj: sysprim.c $(SCHEME_H) $(PRIMS_H) $(OSTTY_H) $(OSTOP_H)
+term.obj: term.c $(SCHEME_H) $(OSTOP_H) $(OSIO_H) $(OSFS_H) $(OSFILE_H) &
+ $(EDWIN_H)
+tparam.obj: tparam.c ansidecl.h
+transact.obj: transact.c ansidecl.h $(OUTF_H) $(DSTACK_H)
+utils.obj: utils.c $(SCHEME_H) $(PRIMS_H) $(WINDER_H) $(HISTORY_H) &
+ $(CMPINT_H) $(SYSCALL_H)
+vector.obj: vector.c $(SCHEME_H) $(PRIMS_H)
+wind.obj: wind.c $(OBSTACK_H) $(DSTACK_H) $(OUTF_H)
+
+prbfish.obj: prbfish.c $(SCHEME_H) $(PRIMS_H)
+prgdbm.obj: prgdbm.c $(SCHEME_H) $(PRIMS_H) $(OS_H)
+prmd5.obj: prmd5.c $(SCHEME_H) $(PRIMS_H)
+prosenv.obj: prosenv.c $(SCHEME_H) $(PRIMS_H) $(OSENV_H) $(OSTOP_H) $(LIMITS_H)
+prosfile.obj: prosfile.c $(SCHEME_H) $(PRIMS_H) $(OSFILE_H)
+prosfs.obj: prosfs.c $(SCHEME_H) $(PRIMS_H) $(OSFILE_H) $(OSFS_H) $(OSIO_H)
+prosio.obj: prosio.c $(SCHEME_H) $(PRIMS_H) $(OSIO_H)
+prosproc.obj: prosproc.c $(SCHEME_H) $(PRIMS_H) $(OSPROC_H) $(OSIO_H)
+prosterm.obj: prosterm.c $(SCHEME_H) $(PRIMS_H) $(OSTERM_H) $(OSIO_H)
+prostty.obj: prostty.c $(SCHEME_H) $(PRIMS_H) $(OSTTY_H) $(OSCTTY_H) &
+ $(OSFILE_H) $(OSIO_H)
+pruxsock.obj: pruxsock.c $(SCHEME_H) $(PRIMS_H) $(UXSOCK_H)
+prntenv.obj: prntenv.c $(SCHEME_H) $(PRIMS_H) $(NT_H) $(NTIO_H)
+prntfs.obj: prntfs.c $(SCHEME_H) $(PRIMS_H) $(NT_H) $(NTFS_H)
+prntio.obj: prntio.c $(SCHEME_H) $(PRIMS_H) $(NTIO_H) $(NT_H) $(NTSCREEN_H) &
+ $(NTGUI_H) $(SYSCALL_H) $(NTPROC_H) $(OSTTY_H)
+
+fasdump.obj: fasdump.c $(SCHEME_H) $(PRIMS_H) $(OSSCHEME_H) $(OSIO_H) &
+ $(OSFILE_H) $(OSFS_H) $(GCCODE_H) $(TRAP_H) $(LOOKUP_H) $(FASL_H) &
+ $(DUMP_C)
+gcloop.obj: gcloop.c $(SCHEME_H) $(GCCODE_H)
+memmag.obj: memmag.c $(SCHEME_H) $(PRIMS_H) $(MEMMAG_H) $(GCCODE_H)
+purify.obj: purify.c $(SCHEME_H) $(PRIMS_H) $(GCCODE_H) $(ZONES_H)
+wabbit.obj: wabbit.c $(SCHEME_H) $(GCCODE_H)
+
+bchdmp.obj: bchdmp.c $(SCHEME_H) $(PRIMS_H) $(OSFILE_H) $(OSFS_H) $(TRAP_H) &
+ $(LOOKUP_H) $(FASL_H) $(NT_H) $(NTIO_H) $(BCHGCC_H) $(DUMP_C)
+bchgcl.obj: bchgcl.c $(SCHEME_H) $(BCHGCC_H)
+bchmmg.obj: bchmmg.c $(SCHEME_H) $(PRIMS_H) $(MEMMAG_H) $(OPTION_H) &
+ $(OSENV_H) $(OSENV_H) $(NT_H) $(BCHGCC_H) $(BCHDRN_H)
+bchpur.obj: bchpur.c $(SCHEME_H) $(PRIMS_H) $(BCHGCC_H) $(ZONES_H)
+bchutl.obj: bchutl.c $(CONFIG_H)
+
+intext.obj: intext.c ansidecl.h $(DSTACK_H) $(INTEXT_H)
+ntenv.obj: ntenv.c $(SCHEME_H) $(NT_H) $(OSENV_H) $(NTSCREEN_H)
+ntfile.obj: ntfile.c $(NT_H) $(OSFILE_H) $(NTIO_H)
+ntfs.obj: ntfs.c $(NT_H) $(NTFS_H) $(OUTF_H)
+ntgui.obj: ntgui.c $(SCHEME_H) $(PRIMS_H) $(OS_H) $(NT_H) $(NTDIALOG_H) &
+ $(NTGUI_H) $(NTSCREEN_H)
+ntio.obj: ntio.c $(SCHEME_H) $(PRIMS_H) $(NT_H) $(NTIO_H) $(OSTERM_H) &
+ $(OSFILE_H) $(OUTF_H) $(OSSIG_H) $(INTRPT_H) $(NTSCREEN_H)
+ntproc.obj: ntproc.c $(NT_H) $(NTPROC_H) $(NTIO_H) $(NTSCREEN_H) $(NTGUI_H)
+ntscreen.obj: ntscreen.c $(NT_H) $(NTSCREEN_H) $(NTGUI_H)
+ntsig.obj: ntsig.c $(SCHEME_H) $(CRITSEC_H) $(OSSIG_H) $(OSCTTY_H) $(OSTTY_H) &
+ $(NT_H) $(NTGUI_H) $(NTIO_H) $(NTSCMLIB_H) $(NTSCREEN_H) $(NTSYS_H)
+ntsock.obj: ntsock.c $(SCHEME_H) $(PRIMS_H) $(NT_H) $(NTIO_H) $(UXSOCK_H)
+ntsys.obj: ntsys.c $(NT_H) $(NTSYS_H)
+nttop.obj: nttop.c $(NT_H) $(NTTOP_H) $(OSCTTY_H) $(PRIMS_H) $(ERRORS_H) &
+ $(OPTION_H) $(OUTF_H) $(NTSCMLIB_H)
+nttrap.obj: nttrap.c $(SCHEME_H) $(OS_H) $(NT_H) $(NTTRAP_H) $(GCCODE_H) &
+ $(NTSCMLIB_H)
+nttterm.obj: $(NTTTERM_H) $(SCHEME_H) $(PRIMS_H) $(OSTERM_H)
+nttty.obj: nttty.c $(NT_H) $(OSTTY_H) $(OSENV_H) $(NTIO_H) $(NTTERM_H) &
+ $(NTSCREEN_H)
+ntasutl.obj: ntasutl.asm
+
+missing.obj: missing.c $(CONFIG_H)
+
+findprim.$(OBJ): findprim.c $(CONFIG_H)
+
+bintopsb.obj: bintopsb.c $(PSBMAP_H) $(LIMITS_H) $(LOAD_C) $(BLTDEF_H) &
+ $(TRAP_H)
+psbtobin.obj: psbtobin.c $(PSBMAP_H) $(FLOAT_H) $(LIMITS_H) $(FASL_H) $(DUMP_C)
BEGIN
VALUE "CompanyName", "Artifical Intelligence Lab, MIT"
VALUE "FileDescription", "MIT Scheme Microcode"
- VALUE "FileVersion", MAKEFILEVERSIONSTRING(VERSION,SUBVERSION)
+ VALUE "FileVersion", MAKEFILEVERSIONSTRING(SCHEME_VERSION,SCHEME_SUBVERSION)
VALUE "InternalName", "SCHEME"
- VALUE "LegalCopyright", "Copyright Massachusetts Institute of Technology 1993-1994"
+ VALUE "LegalCopyright", "Copyright Massachusetts Institute of Technology 1993-2000"
VALUE "OriginalFilename", "SCHEME.EXE"
VALUE "ProductName", "MIT Scheme"
- VALUE "ProductVersion", RELEASE
+ VALUE "ProductVersion", SCHEME_RELEASE
END
END
/* -*-C-*-
-$Id: object.h,v 9.49 1999/01/02 06:06:43 cph Exp $
+$Id: object.h,v 9.50 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
\f
/* The value in "Wsize.c" for `TYPE_CODE_LENGTH' must match this!! */
#ifndef TYPE_CODE_LENGTH
-#define TYPE_CODE_LENGTH 8
+# define TYPE_CODE_LENGTH 8
#endif
-#ifdef MIN_TYPE_CODE_LENGTH
-#if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
-#include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
+#if defined(MIN_TYPE_CODE_LENGTH) && (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
+# include "Inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
#endif
+
+#if (SIZEOF_UNSIGNED_LONG == 4) /* 32 bit word versions */
+# if (TYPE_CODE_LENGTH == 8)
+# define MAX_TYPE_CODE 0xFF
+# define DATUM_LENGTH 24
+# define FIXNUM_LENGTH 23
+# define FIXNUM_SIGN_BIT 0x00800000
+# define SIGN_MASK 0xFF800000
+# define SMALLEST_FIXNUM ((long) 0xFF800000)
+# define BIGGEST_FIXNUM ((long) 0x007FFFFF)
+# define HALF_DATUM_LENGTH 12
+# define HALF_DATUM_MASK 0x00000FFF
+# define DATUM_MASK 0x00FFFFFF
+# define TYPE_CODE_MASK 0xFF000000
+# endif
+# if (TYPE_CODE_LENGTH == 6)
+# define MAX_TYPE_CODE 0x3F
+# define DATUM_LENGTH 26
+# define FIXNUM_LENGTH 25
+# define FIXNUM_SIGN_BIT 0x02000000
+# define SIGN_MASK 0xFE000000
+# define SMALLEST_FIXNUM ((long) 0xFE000000)
+# define BIGGEST_FIXNUM ((long) 0x01FFFFFF)
+# define HALF_DATUM_LENGTH 13
+# define HALF_DATUM_MASK 0x00001FFF
+# define DATUM_MASK 0x03FFFFFF
+# define TYPE_CODE_MASK 0XFC000000
+# endif
#endif
-#ifdef b32 /* 32 bit word versions */
-#if (TYPE_CODE_LENGTH == 8)
-
-#define MAX_TYPE_CODE 0xFF
-#define DATUM_LENGTH 24
-#define FIXNUM_LENGTH 23
-#define FIXNUM_SIGN_BIT 0x00800000
-#define SIGN_MASK 0xFF800000
-#define SMALLEST_FIXNUM ((long) 0xFF800000)
-#define BIGGEST_FIXNUM ((long) 0x007FFFFF)
-#define HALF_DATUM_LENGTH 12
-#define HALF_DATUM_MASK 0x00000FFF
-#define DATUM_MASK 0x00FFFFFF
-#define TYPE_CODE_MASK 0xFF000000
-
-#endif /* (TYPE_CODE_LENGTH == 8) */
-#if (TYPE_CODE_LENGTH == 6)
-
-#define MAX_TYPE_CODE 0x3F
-#define DATUM_LENGTH 26
-#define FIXNUM_LENGTH 25
-#define FIXNUM_SIGN_BIT 0x02000000
-#define SIGN_MASK 0xFE000000
-#define SMALLEST_FIXNUM ((long) 0xFE000000)
-#define BIGGEST_FIXNUM ((long) 0x01FFFFFF)
-#define HALF_DATUM_LENGTH 13
-#define HALF_DATUM_MASK 0x00001FFF
-#define DATUM_MASK 0x03FFFFFF
-#define TYPE_CODE_MASK 0XFC000000
-
-#endif /* (TYPE_CODE_LENGTH == 6) */
-#endif /* b32 */
#ifndef DATUM_LENGTH /* Safe versions */
-
-#define MAX_TYPE_CODE ((1 << TYPE_CODE_LENGTH) - 1)
-#define DATUM_LENGTH (OBJECT_LENGTH - TYPE_CODE_LENGTH)
-/* FIXNUM_LENGTH does NOT include the sign bit! */
-#define FIXNUM_LENGTH (DATUM_LENGTH - 1)
-#define FIXNUM_SIGN_BIT (1L << FIXNUM_LENGTH)
-#define SIGN_MASK ((long) (-1L << FIXNUM_LENGTH))
-#define SMALLEST_FIXNUM ((long) (-1L << FIXNUM_LENGTH))
-#define BIGGEST_FIXNUM ((1L << FIXNUM_LENGTH) - 1)
-#define HALF_DATUM_LENGTH (DATUM_LENGTH / 2)
-#define HALF_DATUM_MASK ((1L << HALF_DATUM_LENGTH) - 1)
-#define DATUM_MASK ((1L << DATUM_LENGTH) - 1)
-#define TYPE_CODE_MASK (~ DATUM_MASK)
-
-#endif /* DATUM_LENGTH */
+# define MAX_TYPE_CODE ((1 << TYPE_CODE_LENGTH) - 1)
+# define DATUM_LENGTH (OBJECT_LENGTH - TYPE_CODE_LENGTH)
+ /* FIXNUM_LENGTH does NOT include the sign bit! */
+# define FIXNUM_LENGTH (DATUM_LENGTH - 1)
+# define FIXNUM_SIGN_BIT (1L << FIXNUM_LENGTH)
+# define SIGN_MASK ((long) (-1L << FIXNUM_LENGTH))
+# define SMALLEST_FIXNUM ((long) (-1L << FIXNUM_LENGTH))
+# define BIGGEST_FIXNUM ((1L << FIXNUM_LENGTH) - 1)
+# define HALF_DATUM_LENGTH (DATUM_LENGTH / 2)
+# define HALF_DATUM_MASK ((1L << HALF_DATUM_LENGTH) - 1)
+# define DATUM_MASK ((1L << DATUM_LENGTH) - 1)
+# define TYPE_CODE_MASK (~ DATUM_MASK)
+#endif
\f
/* Basic object structure */
#include "obstack.h"
-#ifdef __STDC__
+#ifdef HAVE_STDC
#define POINTER void *
#else
#define POINTER char *
more recently than OBJ. If OBJ is zero, free everything in H. */
void
-#ifdef __STDC__
+#ifdef HAVE_STDC
#undef obstack_free
obstack_free (struct obstack *h, POINTER obj)
#else
/* Let same .o link with output of gcc and other compilers. */
-#ifdef __STDC__
+#ifdef HAVE_STDC
void
_obstack_free (h, obj)
struct obstack *h;
/* Now define the functional versions of the obstack macros.
Define them to simply use the corresponding macros to do the job. */
-#ifdef __STDC__
+#ifdef HAVE_STDC
/* These function definitions do not work with non-ANSI preprocessors;
they won't pass through the macro names in parentheses. */
return obstack_copy0 (obstack, pointer, length);
}
-#endif /* __STDC__ */
+#endif /* HAVE_STDC */
#endif /* 0 */
#ifndef __OBSTACKS__
#define __OBSTACKS__
\f
-#include "ansidecl.h"
+#include "config.h"
+
+#ifdef STDC_HEADERS
+# include <string.h>
+#endif
/* We use subtraction of (char *)0 instead of casting to int
because on word-addressable machines a simple cast to int
/* Declare the external functions we use; they are in obstack.c. */
#ifndef _SUNOS4
-extern void
- EXFUN (abort, (void));
+extern void EXFUN (abort, (void));
#endif
-#ifdef __STDC__
+#ifdef HAVE_STDC
extern void _obstack_newchunk (struct obstack *, int);
extern void _obstack_free (struct obstack *, void *);
extern void _obstack_begin (struct obstack *, int, long,
extern void _obstack_begin ();
#endif
\f
-#ifdef __STDC__
+#ifdef HAVE_STDC
/* Do the function-declarations after the structs
but before defining the macros. */
int obstack_alignment_mask (struct obstack *obstack);
int obstack_chunk_size (struct obstack *obstack);
-#endif /* __STDC__ */
+#endif /* HAVE_STDC */
/* Non-ANSI C cannot really support alternative functions for these macros,
so we do not declare them. */
(h)->object_base = (h)->next_free, \
__INT_TO_PTR ((h)->temp))
-#ifdef __STDC__
+#ifdef HAVE_STDC
#define obstack_free(h,obj) \
( (h)->temp = (char *)(obj) - (char *) (h)->chunk, \
(((h)->temp >= 0 && (h)->temp < (h)->chunk_limit - (char *) (h)->chunk)\
/* -*-C-*-
-$Id: option.c,v 1.54 2000/10/16 17:22:12 cph Exp $
+$Id: option.c,v 1.55 2000/12/05 21:23:46 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
#define xfree(p) free ((PTR) (p))
extern int atoi ();
-#ifdef WINNT
-
-#include <io.h>
-#include <string.h>
-#include <stdlib.h>
-#include "nt.h"
-#include "ntio.h"
-
-#else /* not WINNT */
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
-#ifdef _POSIX
-#include <unistd.h>
-#else
-extern int strlen ();
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <string.h>
#endif
-#ifdef __STDC__
-#include <stdlib.h>
-#include <string.h>
-#else
-extern char * EXFUN (malloc, (int));
+#ifdef HAVE_MALLOC_H
+# include <malloc.h>
#endif
-#endif /* not WINNT */
+#ifdef __WIN32__
+# include <io.h>
+# include "nt.h"
+# include "ntio.h"
+#endif
#ifndef NULL
# define NULL 0
#endif
-#if defined(DOS386) || defined(WINNT) || defined(_OS2)
-#define DOS_LIKE_FILENAMES
+#if defined(__WIN32__) || defined(__OS2__)
+# define DOS_LIKE_FILENAMES
#endif
extern struct obstack scratch_obstack;
\f
#ifdef HAS_COMPILER_SUPPORT
-#ifdef hp9000s800
+#if defined(hp9000s800) || defined(__hp9000s800)
/* HPPA compiled binaries are large! */
#ifndef DEFAULT_SMALL_CONSTANT
#endif /* mips */
-#ifdef i386
+#ifdef __IA32__
/* 386 code is large too! */
#ifndef DEFAULT_SMALL_CONSTANT
#define DEFAULT_LARGE_CONSTANT 1200
#endif
-#endif /* i386 */
+#endif /* __IA32__ */
#endif /* HAS_COMPILER_SUPPORT */
CONST char * filename AND
SCHEME_OBJECT * header)
{
-#ifdef WINNT
+#ifdef __WIN32__
HANDLE handle
= (CreateFile (filename,
CloseHandle (handle);
return (1);
-#else /* not WINNT */
+#else /* not __WIN32__ */
FILE * stream = (fopen (filename, "r"));
if (stream == 0)
fclose (stream);
return (1);
-#endif /* not WINNT */
+#endif /* not __WIN32__ */
}
static int
dir = (environment_default ("TMP", 0));
if ((dir == 0) || (!OS_file_directory_p (dir)))
dir = (environment_default ("TMP", 0));
-#ifdef _UNIX
+#ifdef __unix__
if ((dir == 0) || (!OS_file_directory_p (dir)))
{
if (OS_file_directory_p ("/var/tmp"))
if (OS_file_directory_p ("/tmp"))
dir = "/tmp";
}
-#endif /* _UNIX */
+#endif /* __unix__ */
if ((dir == 0) || (!OS_file_directory_p (dir)))
dir = DEFAULT_GC_DIRECTORY;
option_gc_directory = (string_option (option_gc_directory, dir));
/* -*-C-*-
-$Id: os.h,v 1.6 1999/01/02 06:11:34 cph Exp $
+$Id: os.h,v 1.7 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#ifndef SCM_OS_H
#define SCM_OS_H
-#include "ansidecl.h"
-#include "oscond.h"
-#include "posixtyp.h"
+#include "config.h"
typedef unsigned int Tchannel;
/* -*-C-*-
-$Id: os2.h,v 1.6 1999/01/02 06:11:34 cph Exp $
+$Id: os2.h,v 1.7 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#ifndef SCM_OS2_H
#define SCM_OS2_H
+#include "config.h"
#include "dstack.h"
#include "osscheme.h"
#include "syscall.h"
/* Defined by "scheme.h" and conflicts with definition in <os2.h>.
Scheme's definition not needed in OS/2 files. */
-#undef END_OF_CHAIN
+#ifdef END_OF_CHAIN
+# undef END_OF_CHAIN
+#endif
#define INCL_BASE
#define INCL_PM
#include <stdlib.h>
#include <stddef.h>
#include <string.h>
+#include <ctype.h>
#include <setjmp.h>
#include <limits.h>
/* -*-C-*-
-$Id: os2fs.c,v 1.11 1999/12/21 18:48:32 cph Exp $
+$Id: os2fs.c,v 1.12 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "osfs.h"
#ifdef __GCC2__
-#define stricmp strcasecmp
-#define strnicmp strncasecmp
+# define stricmp strcasecmp
+# define strnicmp strncasecmp
+#endif
+
+#ifndef FILE_TOUCH_OPEN_TRIES
+# define FILE_TOUCH_OPEN_TRIES 5
#endif
static const char * make_pathname (const char *, const char *);
(dos_delete_dir, (OS2_remove_trailing_backslash (directory_name)));
}
\f
+static void protect_handle (LHANDLE);
+
+int
+OS_file_touch (const char * filename)
+{
+ HFILE handle;
+ ULONG action;
+ APIRET rc;
+ unsigned int count = 0;
+
+ transaction_begin ();
+ while (1)
+ {
+ APIRET rc
+ = (dos_open (((char *) filename),
+ (&handle),
+ (&action),
+ 0,
+ FILE_NORMAL,
+ (OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_CREATE_IF_NEW),
+ (OPEN_ACCESS_READWRITE | OPEN_SHARE_DENYREADWRITE),
+ 0));
+ if (rc == NO_ERROR)
+ break;
+ if ((rc != NO_ERROR)
+ && (rc != ERROR_FILE_NOT_FOUND)
+ && (rc != ERROR_PATH_NOT_FOUND)
+ && ((++ count) >= FILE_TOUCH_OPEN_TRIES))
+ OS2_error_system_call (rc, syscall_dos_open);
+ }
+ protect_handle (handle);
+ if (action == FILE_CREATED)
+ {
+ transaction_commit ();
+ return (1);
+ }
+ /* Existing file -- we'll write something to it to make sure that it
+ has its times updated properly upon close. This was needed for
+ unix implementation, but it is not known whether it is needed in
+ OS/2. In any case, it does no harm to do this. */
+ {
+ FILESTATUS3 info;
+ char buffer [1];
+ ULONG n;
+ STD_API_CALL (dos_query_file_info,
+ (handle, FIL_STANDARD, (& info), (sizeof (info))));
+ if ((info . cbFile) == 0)
+ {
+ /* Zero-length file: write a byte, then reset the length. */
+ (buffer[0]) = '\0';
+ STD_API_CALL (dos_write, (handle, buffer, 1, (& n)));
+ STD_API_CALL (dos_set_file_size, (handle, 0));
+ }
+ else
+ {
+ /* Read the first byte, then write it back in place. */
+ STD_API_CALL (dos_read, (handle, buffer, 1, (&n)));
+ STD_API_CALL (dos_set_file_ptr, (handle, 0, FILE_BEGIN, (& n)));
+ STD_API_CALL (dos_write, (handle, buffer, 1, (& n)));
+ }
+ }
+ transaction_commit ();
+ return (0);
+}
+
+static void
+protect_handle_1 (void * hp)
+{
+ (void) dos_close (* ((LHANDLE *) hp));
+}
+
+static void
+protect_handle (LHANDLE h)
+{
+ LHANDLE * hp = (dstack_alloc (sizeof (LHANDLE)));
+ (*hp) = h;
+ transaction_record_action (tat_always, protect_handle_1, hp);
+}
+\f
typedef struct
{
char allocatedp;
/* -*-C-*-
-$Id: os2msg.c,v 1.13 1999/01/02 06:11:34 cph Exp $
+$Id: os2msg.c,v 1.14 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "os2.h"
+extern void EXFUN (tty_set_next_interrupt_char, (cc_t c));
extern void * OS2_malloc_noerror (unsigned int);
static qid_t allocate_qid (void);
/* -*-C-*-
-$Id: os2pm.c,v 1.32 1999/01/02 06:11:34 cph Exp $
+$Id: os2pm.c,v 1.33 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#define INCL_GPI
#include "os2.h"
+extern void add_reload_cleanup (void (*) (void));
extern psid_t OS2_console_psid (void);
extern void OS2_console_font_change_hook (font_metrics_t *);
\f
/* -*-C-*-
-$Id: os2pmcon.c,v 1.25 1999/04/28 03:50:38 cph Exp $
+$Id: os2pmcon.c,v 1.26 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
(void) WinMessageBox
(HWND_DESKTOP, NULLHANDLE,
"This is MIT Scheme Release "
- RELEASE
+ SCHEME_RELEASE
", brought to you by the MIT Scheme Team.\n",
"The Uncommon Lisp", 0, MB_OK);
break;
/* -*-C-*-
-$Id: os2proc.c,v 1.6 1999/01/02 06:11:34 cph Exp $
+$Id: os2proc.c,v 1.7 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1995-1999 Massachusetts Institute of Technology
+Copyright (c) 1995-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "os2.h"
#include "osproc.h"
+#include "osenv.h"
extern const char * OS_working_dir_pathname (void);
\f
/* -*-C-*-
-$Id: os2sock.c,v 1.14 1999/10/28 03:53:51 cph Exp $
+$Id: os2sock.c,v 1.15 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
using TCP/IP 4.1, but this code was designed for TCP/IP 4.0. */
#define TCPV40HDRS
+#include "scheme.h"
+#include "prims.h"
+#include "osscheme.h"
#include "os2.h"
#include "uxsock.h"
/* -*-C-*-
-$Id: os2term.c,v 1.3 1999/01/02 06:11:34 cph Exp $
+$Id: os2term.c,v 1.4 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1994, 1999 Massachusetts Institute of Technology
+Copyright (c) 1994, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
*/
#include "os2.h"
+#include "prims.h"
\f
unsigned int
OS_terminal_get_ispeed (Tchannel channel)
/* -*-C-*-
-$Id: os2top.c,v 1.20 2000/05/20 18:59:13 cph Exp $
+$Id: os2top.c,v 1.21 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
*/
#define SCM_OS2TOP_C
-#include "scheme.h"
#define INCL_WIN
+
+#include "scheme.h"
#include "os2.h"
#include "ostop.h"
#include "option.h"
+
#ifndef DISABLE_SOCKET_SUPPORT
-#include <nerrno.h>
+# include <nerrno.h>
#endif
+extern void execute_reload_cleanups (void);
+
extern void OS2_initialize_channels (void);
extern void OS2_initialize_channel_thread_messages (void);
extern void OS2_initialize_console (void);
@echo off
rem MIT Scheme microcode configuration script for OS/2
rem
-rem Copyright (c) 1994 Massachusetts Institute of Technology
+rem Copyright (c) 1994, 1995, 2000 Massachusetts Institute of Technology
rem
-rem $Id: config.cmd,v 1.3 1995/10/15 00:42:09 cph Exp $
+rem $Id: config.cmd,v 1.4 2000/12/05 21:23:51 cph Exp $
rem
copy cmpintmd\i386.h cmpintmd.h
copy cmpauxmd\i386.m4 cmpauxmd.m4
copy os2utl\makefile .
+copy os2utl\config.h .
copy cmpauxmd\asmcvt.c .
echo ***** Read and edit the makefile! *****
--- /dev/null
+/* -*-C-*-
+
+$Id: config.h,v 1.2 2000/12/05 21:23:51 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*/
+
+#ifndef SCM_CONFIG_H
+#define SCM_CONFIG_H
+
+#ifndef __OS2__
+# define __OS2__
+#endif
+
+#include <sys/types.h>
+#include <time.h>
+
+#ifndef __GNUC__
+typedef unsigned short mode_t;
+typedef short nlink_t;
+typedef long pid_t;
+typedef short uid_t;
+typedef short gid_t;
+#endif
+
+typedef unsigned char cc_t;
+typedef long ssize_t;
+
+/* The number of bytes in a unsigned long. */
+#define SIZEOF_UNSIGNED_LONG 4
+
+/* Define if your processor stores words with the most significant
+ byte first (like Motorola and SPARC, unlike Intel and VAX). */
+/* #undef WORDS_BIGENDIAN */
+
+/* Define if you have the floor function. */
+#define HAVE_FLOOR 1
+
+/* Define if you have the frexp function. */
+#define HAVE_FREXP 1
+
+/* Define if you have the modf function. */
+#define HAVE_MODF 1
+
+/* Define if you have the ANSI C header files. */
+#define STDC_HEADERS 1
+
+/* Define if you have the <unistd.h> header file. */
+/* #undef HAVE_UNISTD_H */
+
+/* Define if you have the <fcntl.h> header file. */
+#define HAVE_FCNTL_H 1
+
+/* Define if architecture has native-code compiler support. */
+#define HAS_COMPILER_SUPPORT 1
+
+/* Include the shared configuration header. */
+#include "confshared.h"
+
+#endif /* SCM_CONFIG_H */
### -*- Fundamental -*-
###
-### $Id: makefile,v 1.14 1999/01/02 06:11:34 cph Exp $
+### $Id: makefile,v 1.15 2000/12/05 21:23:51 cph Exp $
###
-### Copyright (c) 1994-1999 Massachusetts Institute of Technology
+### Copyright (c) 1994-2000 Massachusetts Institute of Technology
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License as
#### Makefile for Scheme under OS/2
-all: scheme.exe bchschem.exe bintopsb.exe psbtobin.exe
+all: scheme.exe bchschem.exe
# Uncomment exactly one of the following two lines:
-debug_mode = debug
-#debug_mode = optimize
+#debug_mode = debug
+debug_mode = optimize
# Uncomment exactly one of the following include statements to
# customize this makefile for your compiler. All of the
### -*- Fundamental -*-
###
-### $Id: makefile.cmn,v 1.12 1999/05/11 03:50:57 cph Exp $
+### $Id: makefile.cmn,v 1.13 2000/12/05 21:23:51 cph Exp $
###
-### Copyright (c) 1994-1999 Massachusetts Institute of Technology
+### Copyright (c) 1994-2000 Massachusetts Institute of Technology
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License as
#### Makefile for Scheme under OS/2 -- Common Part
\f
-MACHINE_SOURCES = cmpint.c # cmpauxmd.m4
-MACHINE_OBJECTS = cmpint.$(OBJ) cmpauxmd.$(OBJ)
-GC_HEAD_FILES = gccode.h cmpgc.h cmpintmd.h
-USER_PRIM_SOURCES =
-USER_PRIM_OBJECTS =
-USER_LIBS =
-
-SCHEME_SOURCES = $(USER_PRIM_SOURCES) missing.c
-SCHEME_OBJECTS = $(USER_PRIM_OBJECTS) missing.$(OBJ)
-SCHEME_LIB = $(USER_LIBS) so32dll.lib tcp32dll.lib \
- gdbm.lib md5.lib blowfish.lib
+SCHEME_LIB = so32dll.lib tcp32dll.lib gdbm.lib md5.lib blowfish.lib
CORE_SOURCES = \
-$(MACHINE_SOURCES) \
artutl.c \
avltree.c \
bignum.c \
bitstr.c \
boot.c \
char.c \
+cmpauxmd.m4 \
+cmpint.c \
comutl.c \
daemon.c \
debug.c \
list.c \
lookprm.c \
lookup.c \
+missing.c \
obstack.c \
option.c \
osscheme.c \
wind.c
CORE_OBJECTS = \
-$(MACHINE_OBJECTS) \
artutl.$(OBJ) \
avltree.$(OBJ) \
bignum.$(OBJ) \
bitstr.$(OBJ) \
boot.$(OBJ) \
char.$(OBJ) \
+cmpauxmd.$(OBJ) \
+cmpint.$(OBJ) \
comutl.$(OBJ) \
daemon.$(OBJ) \
debug.$(OBJ) \
list.$(OBJ) \
lookprm.$(OBJ) \
lookup.$(OBJ) \
+missing.$(OBJ) \
obstack.$(OBJ) \
option.$(OBJ) \
osscheme.$(OBJ) \
pros2fs.c \
pros2io.c \
pros2pm.c
-# prospty.c
OS_PRIM_OBJECTS = \
prbfish.$(OBJ) \
pros2fs.$(OBJ) \
pros2io.$(OBJ) \
pros2pm.$(OBJ)
-#prospty.$(OBJ)
OS2_SOURCES = \
os2.c \
os2tty.$(OBJ) \
os2xcpt.$(OBJ)
-HEAD_FILES = scheme.tch prims.h zones.h locks.h bignum.h \
- $(GC_HEAD_FILES) trap.h lookup.h history.h cmpint.h
+SHARED_SOURCES = $(CORE_SOURCES) $(OS_PRIM_SOURCES) $(OS2_SOURCES)
+SHARED_OBJECTS = $(CORE_OBJECTS) $(OS_PRIM_OBJECTS) $(OS2_OBJECTS)
-SOURCES = $(CORE_SOURCES) $(STD_GC_SOURCES)
-OBJECTS = $(CORE_OBJECTS) $(STD_GC_OBJECTS) $(OS2_OBJECTS) \
- $(OS_PRIM_OBJECTS) usrdef.$(OBJ)
+SOURCES = $(SHARED_SOURCES) $(STD_GC_SOURCES)
+OBJECTS = $(SHARED_OBJECTS) $(STD_GC_OBJECTS) usrdef.$(OBJ)
-BCHSOURCES = $(CORE_SOURCES) $(BCH_GC_SOURCES)
-BCHOBJECTS = $(CORE_OBJECTS) $(BCH_GC_OBJECTS) $(OS2_OBJECTS) \
- $(OS_PRIM_OBJECTS) bchdef.$(OBJ)
+BCHSOURCES = $(SHARED_SOURCES) $(BCH_GC_SOURCES)
+BCHOBJECTS = $(SHARED_OBJECTS) $(BCH_GC_OBJECTS) bchdef.$(OBJ)
-clean :
+usrdef.c: $(SOURCES) findprim.exe
+ .\findprim $(SOURCES) > usrdef.c
+
+bchdef.c: $(BCHSOURCES) findprim.exe
+ .\findprim $(BCHSOURCES) > bchdef.c
+
+scheme.res: os2pmcon.rc os2pmcon.h
+ rc -r -DSCHEME os2pmcon.rc scheme.res
+
+bchschem.res: os2pmcon.rc os2pmcon.h
+ rc -r -DBCHSCHEM os2pmcon.rc bchschem.res
+
+findprim.exe: findprim.$(OBJ)
+asmcvt.exe: asmcvt.$(OBJ)
+bintopsb.exe: bintopsb.$(OBJ) missing.$(OBJ)
+psbtobin.exe: psbtobin.$(OBJ) missing.$(OBJ)
+breakup.exe: breakup.$(OBJ)
+wsize.exe: wsize.$(OBJ)
+ppband.exe: ppband.$(OBJ)
+
+os2pm-dc.h os2pm-ed.h os2pm-id.h os2pm-mi.h os2pm-mt.h os2pm-rp.h: os2pm.scm
+ scheme -large < os2utl/mkos2pm.scm
+
+clean:
-del *.$(OBJ)
-del *.exe
- -del *.tch
-del *.res
-del *.err
-del *.sym
-del usrdef.c
-del bchdef.c
-findprim.exe : findprim.$(OBJ)
-asmcvt.exe : asmcvt.$(OBJ)
-bintopsb.exe : bintopsb.$(OBJ) missing.$(OBJ)
-psbtobin.exe : psbtobin.$(OBJ) missing.$(OBJ)
-breakup.exe : breakup.$(OBJ)
-wsize.exe : wsize.$(OBJ)
-ppband.exe : ppband.$(OBJ)
-
-usrdef.c : $(SCHEME_SOURCES) $(SOURCES) $(OS_PRIM_SOURCES) usrdef.tch \
- findprim.exe
- .\findprim $(SCHEME_SOURCES) $(SOURCES) $(OS_PRIM_SOURCES) > usrdef.c
-
-bchdef.c : $(SCHEME_SOURCES) $(BCHSOURCES) $(OS_PRIM_SOURCES) usrdef.tch \
- findprim.exe
- .\findprim $(SCHEME_SOURCES) $(BCHSOURCES) $(OS_PRIM_SOURCES) > bchdef.c
-
-cmpauxmd.$(ASM) : cmpauxmd.m4
-
-cmpauxmd.$(OBJ) : cmpauxmd.$(ASM)
-
-scheme.tch : scheme.h oscond.h ansidecl.h dstack.h obstack.h config.h \
- bkpt.h object.h scode.h sdata.h gc.h interp.h stack.h futures.h \
- types.h errors.h returns.h const.h fixobj.h default.h extern.h \
- prim.h intrpt.h critsec.h outf.h
- echo touch > $@
-
-psbmap.tch : config.h object.h bignum.h bignmint.h bitstr.h types.h \
- sdata.h const.h psbmap.h $(GC_HEAD_FILES) comlin.h comlin.c
- echo touch > $@
-
-usrdef.tch : usrdef.h config.h object.h prim.h
- echo touch > $@
-
-foo $(USER_PRIM_OBJECTS) : $(HEAD_FILES)
-
-interp.$(OBJ) : scheme.tch locks.h trap.h lookup.h history.h cmpint.h zones.h \
- prmcon.h
-
-hooks.$(OBJ) : scheme.tch prims.h winder.h history.h
-
-utils.$(OBJ) : scheme.tch prims.h winder.h history.h cmpint.h syscall.h
-
-primutl.$(OBJ) : scheme.tch os.h prims.h usrdef.h prename.h syscall.h \
- avltree.h $(GC_HEAD_FILES)
-
-hunk.$(OBJ) list.$(OBJ) step.$(OBJ) vector.$(OBJ) : scheme.tch prims.h
-sysprim.$(OBJ) daemon.$(OBJ) prim.$(OBJ) extern.$(OBJ) : scheme.tch prims.h
-
-lookup.$(OBJ) lookprm.$(OBJ) debug.$(OBJ) intern.$(OBJ) : scheme.tch prims.h \
- lookup.h trap.h locks.h
-fasload.$(OBJ) : scheme.tch prims.h osscheme.h osfile.h osio.h \
- $(GC_HEAD_FILES) trap.h option.h prmcon.h load.c fasl.h
-fasdump.$(OBJ) : scheme.tch prims.h osio.h osfile.h osfs.h $(GC_HEAD_FILES) \
- trap.h lookup.h fasl.h dump.c
-memmag.$(OBJ) : scheme.tch prims.h memmag.h $(GC_HEAD_FILES) memmag.h
-gcloop.$(OBJ) : scheme.tch $(GC_HEAD_FILES)
-purify.$(OBJ) : scheme.tch prims.h $(GC_HEAD_FILES) zones.h
-wabbit.$(OBJ) : scheme.tch $(GC_HEAD_FILES)
-purutl.$(OBJ) : scheme.tch prims.h $(GC_HEAD_FILES) zones.h
-comutl.$(OBJ) : scheme.tch prims.h
-gctype.$(OBJ) : config.h
-artutl.$(OBJ) : scheme.tch
-avltree.$(OBJ) : ansidecl.h avltree.h
-bignum.$(OBJ) : scheme.tch bignmint.h
-bigprm.$(OBJ) flonum.$(OBJ) intprm.$(OBJ) : scheme.tch prims.h zones.h
-generic.$(OBJ) : scheme.tch prims.h
-fixnum.$(OBJ) : scheme.tch prims.h mul.c
-storage.$(OBJ) : scheme.tch gctype.c
-char.$(OBJ) string.$(OBJ) dfloat.$(OBJ) : scheme.tch prims.h
-tterm.$(OBJ) : scheme.tch prims.h osterm.h
-boot.$(OBJ) : scheme.tch prims.h version.h option.h ostop.h os.h
-option.$(OBJ) : scheme.tch fasl.h osenv.h osfs.h
-term.$(OBJ) : scheme.tch
-missing.$(OBJ) : config.h
-BCHGCC_H = bchgcc.h oscond.h $(GC_HEAD_FILES)
-bchdmp.$(OBJ) : scheme.tch prims.h os2.h osio.h osfile.h trap.h lookup.h \
- $(BCHGCC_H) fasl.h dump.c
-bchdrn.$(OBJ) : ansidecl.h bchdrn.h
-bchmmg.$(OBJ) : scheme.tch prims.h os2.h $(BCHGCC_H) option.h bchdrn.h memmag.h
-bchgcl.$(OBJ) : scheme.tch $(BCHGCC_H)
-bchpur.$(OBJ) : scheme.tch prims.h $(BCHGCC_H) zones.h
-bchutl.$(OBJ) : ansidecl.h
-syntax.$(OBJ) : scheme.tch prims.h edwin.h syntax.h
-bitstr.$(OBJ) : scheme.tch prims.h bitstr.h
-regex.$(OBJ) : scheme.tch syntax.h regex.h
-rgxprim.$(OBJ) : scheme.tch prims.h edwin.h syntax.h regex.h
-bintopsb.$(OBJ) : psbmap.tch trap.h fasl.h load.c bltdef.h
-psbtobin.$(OBJ) : psbmap.tch fasl.h dump.c
-ppband.$(OBJ) : ansidecl.h config.h errors.h types.h const.h object.h \
- $(GC_HEAD_FILES) sdata.h load.c fasl.h
-wsize.$(OBJ) : config.h
-cmpint.$(OBJ) : scheme.tch prim.h $(GC_HEAD_FILES)
-osscheme.$(OBJ) : scheme.tch posixtyp.h os.h osscheme.h
-ostty.$(OBJ) : ansidecl.h oscond.h posixtyp.h os.h ostty.h osscheme.h
-error.$(OBJ) ptrvec.$(OBJ) transact.$(OBJ) : ansidecl.h dstack.h outf.h
-wind.$(OBJ) : ansidecl.h dstack.h obstack.h
-obstack.$(OBJ) : obstack.h
-$(OS_PRIM_OBJECTS) : scheme.tch prims.h posixtyp.h os.h
-prosenv.$(OBJ) : osenv.h ostop.h
-prosfile.$(OBJ) : osfile.h
-prosfs.$(OBJ) : osfs.h
-prosio.$(OBJ) : osio.h
-prosproc.$(OBJ) : osproc.h
-#prospty.$(OBJ) : osterm.h osio.h ospty.h
-pruxsock.$(OBJ) : uxsock.h osio.h
-prosterm.$(OBJ) : osterm.h osio.h
-prostty.$(OBJ) : ostty.h osctty.h osfile.h osio.h
-prmcon.$(OBJ) : scheme.tch prims.h prmcon.h
-
-$(OS2_OBJECTS) pros2fs.$(OBJ) pros2io.$(OBJ) pros2pm.$(OBJ) : \
- dstack.h osscheme.h outf.h os.h ansidecl.h oscond.h posixtyp.h \
- syscall.h osio.h os2.h os2api.h os2cthrd.h os2ctty.h os2io.h \
- os2msg.h os2pm-mt.h os2pm.h os2pm-ed.h os2thrd.h
-os2ctty.$(OBJ) : osctty.h ossig.h
-os2env.$(OBJ) : scheme.tch osenv.h
-os2file.$(OBJ) : osfile.h
-os2fs.$(OBJ) : osfs.h
-os2pm.$(OBJ) : os2pm-id.h os2pm-mi.h os2pm-dc.h os2pm-rp.h
-os2pmcon.$(OBJ) : os2pmcon.h version.h
-os2proc.$(OBJ) : osproc.h
-os2sock.$(OBJ) : uxsock.h
-os2top.$(OBJ) : scheme.tch ostop.h option.h
-os2tty.$(OBJ) : ostty.h
-os2xcpt.$(OBJ) : scheme.tch $(GC_HEAD_FILES)
-pros2fs.$(OBJ) : scheme.tch prims.h osfs.h
-pros2io.$(OBJ) : scheme.tch prims.h
-pros2pm.$(OBJ) : scheme.tch prims.h
-
-scheme.res : os2pmcon.rc os2pmcon.h
- rc -r -DSCHEME os2pmcon.rc scheme.res
-
-bchschem.res : os2pmcon.rc os2pmcon.h
- rc -r -DBCHSCHEM os2pmcon.rc bchschem.res
+#
+# Dependencies. (This was a lot of work!)
+#
+# This first section defines the dependencies of the include files.
+#
+AVLTREE_H = avltree.h $(CONFIG_H)
+BCHDRN_H = bchdrn.h $(CONFIG_H)
+BCHGCC_H = bchgcc.h $(CONFIG_H) $(GCCODE_H)
+BIGNMINT_H = bignmint.h $(PRIMS_H)
+BIGNUM_H = bignum.h ansidecl.h
+BITSTR_H = bitstr.h
+BKPT_H = bkpt.h
+CMPGC_H = cmpgc.h $(CMPINTMD_H)
+CMPINTMD_H = cmpintmd.h $(CMPTYPE_H)
+CMPINT_H = cmpint.h
+CMPTYPE_H = cmptype.h
+COMLIN_H = comlin.h ansidecl.h
+CONFIG_H = config.h confshared.h ansidecl.h
+CONST_H = const.h
+CRITSEC_H = critsec.h
+DEFAULT_H = default.h
+DSTACK_H = dstack.h ansidecl.h
+DUMP_C = dump.c
+EDWIN_H = edwin.h
+ERRORS_H = errors.h
+EXTERN_H = extern.h
+FASL_H = fasl.h
+FIXOBJ_H = fixobj.h
+FLOAT_H =
+FUTURES_H = futures.h
+GCCODE_H = gccode.h $(CMPGC_H)
+GCTYPE_C = gctype.c $(CONFIG_H)
+GC_H = gc.h
+HISTORY_H = history.h
+INTERP_H = interp.h
+INTEXT_H = intext.h ansidecl.h $(DSTACK_H)
+INTRPT_H = intrpt.h
+LIMITS_H =
+LOAD_C = load.c $(FASL_H)
+LOCKS_H = locks.h
+LOOKUP_H = lookup.h
+MEMMAG_H = memmag.h
+MUL_C = mul.c $(CONFIG_H)
+OBJECT_H = object.h
+OBSTACK_H = obstack.h $(CONFIG_H)
+OPTION_H = option.h ansidecl.h
+OS2API_H = os2api.h
+OS2CTHRD_H = os2cthrd.h
+OS2CTTY_H = os2ctty.h
+OS2IO_H = os2io.h $(OSIO_H)
+OS2MSG_H = os2msg.h os2pm-mt.h
+OS2PM_H = os2pm.h os2pm-ed.h
+OS2PMCON_H = os2pmcon.h
+OS2PROC_H = os2proc.h $(OSPROC_H)
+OS2THRD_H = os2thrd.h
+OSCTTY_H = osctty.h $(OS_H)
+OSENV_H = osenv.h $(OS_H)
+OSFILE_H = osfile.h $(OS_H)
+OSFS_H = osfs.h $(OS_H)
+OSIO_H = osio.h $(OS_H)
+OSSCHEME_H = osscheme.h $(OUTF_H) $(OS_H)
+OSSIG_H = ossig.h $(OS_H)
+OSTERM_H = osterm.h $(OS_H)
+OSTOP_H = ostop.h $(OS_H)
+OSTTY_H = ostty.h $(OS_H)
+OS_H = os.h $(CONFIG_H)
+OUTF_H = outf.h $(CONFIG_H)
+PRENAME_H = prename.h
+PRIMS_H = prims.h ansidecl.h
+PRIM_H = prim.h
+PRMCON_H = prmcon.h
+REGEX_H = regex.h
+RETURNS_H = returns.h
+SCODE_H = scode.h
+SDATA_H = sdata.h
+STACK_H = stack.h
+SYNTAX_H = syntax.h
+SYSCALL_H = syscall.h $(CONFIG_H) $(OS2API_H)
+TRAP_H = trap.h
+TYPES_H = types.h
+USRDEF_H = usrdef.h $(SCHEME_H) $(PRIMS_H)
+UXSOCK_H = uxsock.h $(OSIO_H)
+VERSION_H = version.h
+WINDER_H = winder.h
+ZONES_H = zones.h
+
+PSBMAP_H = psbmap.h $(CONFIG_H) $(TYPES_H) $(OBJECT_H) $(BIGNUM_H) \
+ $(BIGNMINT_H) $(SDATA_H) $(CONST_H) $(GCCODE_H) $(CMPTYPE_H) \
+ $(COMLIN_H)
+
+OS2_H = os2.h $(CONFIG_H) $(DSTACK_H) $(OSSCHEME_H) $(SYSCALL_H) $(OS2API_H) \
+ $(OS2MSG_H) $(OS2IO_H) $(OS2THRD_H) $(OS2CTTY_H) $(OS2CTHRD_H) \
+ $(OS2PM_H)
+
+SCHEME_H = scheme.h $(CONFIG_H) $(DSTACK_H) $(OBSTACK_H) $(TYPES_H) \
+ $(CONST_H) $(OBJECT_H) $(INTRPT_H) $(CRITSEC_H) $(GC_H) $(SCODE_H) \
+ $(SDATA_H) $(FUTURES_H) $(ERRORS_H) $(RETURNS_H) $(FIXOBJ_H) \
+ $(STACK_H) $(INTERP_H) $(OUTF_H) $(BKPT_H) $(DEFAULT_H) $(EXTERN_H) \
+ $(BIGNUM_H) $(PRIM_H) $(FLOAT_H)
+
+#
+# This second section is the dependencies of the object files.
+#
+artutl.$(OBJ): artutl.c $(SCHEME_H) $(LIMITS_H)
+avltree.$(OBJ): avltree.c $(AVLTREE_H)
+bignum.$(OBJ): bignum.c $(SCHEME_H) $(BIGNMINT_H) $(LIMITS_H)
+bigprm.$(OBJ): bigprm.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
+bitstr.$(OBJ): bitstr.c $(SCHEME_H) $(PRIMS_H) $(BITSTR_H)
+boot.$(OBJ): boot.c $(SCHEME_H) $(PRIMS_H) $(VERSION_H) $(OPTION_H) \
+ $(OSTOP_H) $(OSTTY_H)
+char.$(OBJ): char.c $(SCHEME_H) $(PRIMS_H)
+cmpauxmd.$(OBJ): cmpauxmd.$(ASM)
+cmpauxmd.$(ASM): cmpauxmd.m4
+cmpint.$(OBJ): cmpint.c $(CONFIG_H) $(DSTACK_H) $(OUTF_H) $(TYPES_H) \
+ $(CONST_H) $(OBJECT_H) $(INTRPT_H) $(GC_H) $(SDATA_H) $(ERRORS_H) \
+ $(RETURNS_H) $(FIXOBJ_H) $(STACK_H) $(INTERP_H) $(DEFAULT_H) \
+ $(EXTERN_H) $(TRAP_H) $(PRIMS_H) $(PRIM_H) $(CMPGC_H)
+comutl.$(OBJ): comutl.c $(SCHEME_H) $(PRIMS_H)
+daemon.$(OBJ): daemon.c $(SCHEME_H) $(PRIMS_H) $(OSIO_H)
+debug.$(OBJ): debug.c $(SCHEME_H) $(PRIMS_H) $(TRAP_H) $(LOOKUP_H)
+dfloat.$(OBJ): dfloat.c $(SCHEME_H) $(PRIMS_H)
+error.$(OBJ): error.c $(OUTF_H) $(DSTACK_H)
+extern.$(OBJ): extern.c $(SCHEME_H) $(PRIMS_H)
+fasload.$(OBJ): fasload.c $(SCHEME_H) $(PRIMS_H) $(OSSCHEME_H) $(OSFILE_H) \
+ $(OSIO_H) $(GCCODE_H) $(TRAP_H) $(OPTION_H) $(PRMCON_H)
+fixnum.$(OBJ): fixnum.c $(SCHEME_H) $(PRIMS_H) $(MUL_C)
+flonum.$(OBJ): flonum.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
+generic.$(OBJ): generic.c $(SCHEME_H) $(PRIMS_H)
+hooks.$(OBJ): hooks.c $(SCHEME_H) $(PRIMS_H) $(WINDER_H) $(HISTORY_H)
+hunk.$(OBJ): hunk.c $(SCHEME_H) $(PRIMS_H)
+intern.$(OBJ): intern.c $(SCHEME_H) $(PRIMS_H) $(TRAP_H)
+interp.$(OBJ): interp.c $(SCHEME_H) $(LOCKS_H) $(TRAP_H) $(LOOKUP_H) \
+ $(WINDER_H) $(HISTORY_H) $(CMPINT_H) $(ZONES_H) $(PRMCON_H)
+intprm.$(OBJ): intprm.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
+list.$(OBJ): list.c $(SCHEME_H) $(PRIMS_H)
+lookprm.$(OBJ): lookprm.c $(SCHEME_H) $(PRIMS_H) $(LOCKS_H) $(TRAP_H) \
+ $(LOOKUP_H)
+lookup.$(OBJ): lookup.c $(SCHEME_H) $(LOCKS_H) $(TRAP_H) $(LOOKUP_H)
+obstack.$(OBJ): obstack.c $(OBSTACK_H)
+option.$(OBJ): option.c $(SCHEME_H) $(FASL_H) $(OSENV_H) $(OSFS_H)
+osscheme.$(OBJ): osscheme.c $(SCHEME_H) $(PRIMS_H) $(OSSCHEME_H)
+ostty.$(OBJ): ostty.c $(OSTTY_H) $(OSSCHEME_H)
+outf.$(OBJ): outf.c $(SCHEME_H)
+prim.$(OBJ): prim.c $(SCHEME_H) $(PRIMS_H)
+primutl.$(OBJ): primutl.c $(SCHEME_H) $(PRIMS_H) $(OS_H) $(USRDEF_H) \
+ $(PRENAME_H) $(SYSCALL_H) $(AVLTREE_H) $(CMPGC_H)
+prmcon.$(OBJ): prmcon.c $(SCHEME_H) $(PRIMS_H) $(PRMCON_H)
+ptrvec.$(OBJ): ptrvec.c $(OUTF_H) $(DSTACK_H)
+purutl.$(OBJ): purutl.c $(SCHEME_H) $(PRIMS_H) $(GCCODE_H) $(ZONES_H) \
+ $(CMPINT_H)
+regex.$(OBJ): regex.c $(SCHEME_H) $(SYNTAX_H) $(REGEX_H)
+rgxprim.$(OBJ): rgxprim.c $(SCHEME_H) $(PRIMS_H) $(EDWIN_H) $(SYNTAX_H) \
+ $(REGEX_H)
+step.$(OBJ): step.c $(SCHEME_H) $(PRIMS_H)
+storage.$(OBJ): storage.c $(SCHEME_H) $(GCTYPE_H)
+string.$(OBJ): string.c $(SCHEME_H) $(PRIMS_H)
+syntax.$(OBJ): syntax.c $(SCHEME_H) $(PRIMS_H) $(EDWIN_H) $(SYNTAX_H)
+sysprim.$(OBJ): sysprim.c $(SCHEME_H) $(PRIMS_H) $(OSTTY_H) $(OSTOP_H)
+term.$(OBJ): term.c $(SCHEME_H) $(OSTOP_H) $(OSIO_H) $(OSFS_H) $(OSFILE_H) \
+ $(EDWIN_H)
+tparam.$(OBJ): tparam.c ansidecl.h
+transact.$(OBJ): transact.c $(CONFIG_H) $(OUTF_H) $(DSTACK_H)
+utils.$(OBJ): utils.c $(SCHEME_H) $(PRIMS_H) $(WINDER_H) $(HISTORY_H) \
+ $(CMPINT_H) $(SYSCALL_H)
+vector.$(OBJ): vector.c $(SCHEME_H) $(PRIMS_H)
+wind.$(OBJ): wind.c $(OBSTACK_H) $(DSTACK_H) $(OUTF_H)
+
+prbfish.$(OBJ): prbfish.c $(SCHEME_H) $(PRIMS_H)
+prgdbm.$(OBJ): prgdbm.c $(SCHEME_H) $(PRIMS_H) $(OS_H)
+prmd5.$(OBJ): prmd5.c $(SCHEME_H) $(PRIMS_H)
+prosenv.$(OBJ): prosenv.c $(SCHEME_H) $(PRIMS_H) $(OSENV_H) $(OSTOP_H) \
+ $(LIMITS_H)
+prosfile.$(OBJ): prosfile.c $(SCHEME_H) $(PRIMS_H) $(OSFILE_H)
+prosfs.$(OBJ): prosfs.c $(SCHEME_H) $(PRIMS_H) $(OSFILE_H) $(OSFS_H) $(OSIO_H)
+prosio.$(OBJ): prosio.c $(SCHEME_H) $(PRIMS_H) $(OSIO_H)
+prosproc.$(OBJ): prosproc.c $(SCHEME_H) $(PRIMS_H) $(OSPROC_H) $(OSIO_H)
+prosterm.$(OBJ): prosterm.c $(SCHEME_H) $(PRIMS_H) $(OSTERM_H) $(OSIO_H)
+prostty.$(OBJ): prostty.c $(SCHEME_H) $(PRIMS_H) $(OSTTY_H) $(OSCTTY_H) \
+ $(OSFILE_H) $(OSIO_H)
+pruxsock.$(OBJ): pruxsock.c $(SCHEME_H) $(PRIMS_H) $(UXSOCK_H)
+pros2fs.$(OBJ): pros2fs.c $(SCHEME_H) $(PRIMS_H) $(OS2_H) $(OSFS_H)
+pros2io.$(OBJ): pros2io.c $(SCHEME_H) $(PRIMS_H) $(OS2_H) $(OS2PROC_H)
+pros2pm.$(OBJ): pros2pm.c $(SCHEME_H) $(PRIMS_H) $(OS2_H)
+
+fasdump.$(OBJ): fasdump.c $(SCHEME_H) $(PRIMS_H) $(OSSCHEME_H) $(OSIO_H) \
+ $(OSFILE_H) $(OSFS_H) $(GCCODE_H) $(TRAP_H) $(LOOKUP_H) $(FASL_H) \
+ $(DUMP_C)
+gcloop.$(OBJ): gcloop.c $(SCHEME_H) $(GCCODE_H)
+memmag.$(OBJ): memmag.c $(SCHEME_H) $(PRIMS_H) $(MEMMAG_H) $(GCCODE_H)
+purify.$(OBJ): purify.c $(SCHEME_H) $(PRIMS_H) $(GCCODE_H) $(ZONES_H)
+wabbit.$(OBJ): wabbit.c $(SCHEME_H) $(GCCODE_H)
+
+bchdmp.$(OBJ): bchdmp.c $(SCHEME_H) $(PRIMS_H) $(OSFILE_H) $(OSFS_H) \
+ $(TRAP_H) $(LOOKUP_H) $(FASL_H) $(OS2_H) $(BCHGCC_H) $(DUMP_C)
+bchgcl.$(OBJ): bchgcl.c $(SCHEME_H) $(BCHGCC_H)
+bchmmg.$(OBJ): bchmmg.c $(SCHEME_H) $(PRIMS_H) $(MEMMAG_H) $(OPTION_H) \
+ $(OSENV_H) $(OSFS_H) $(OS2_H) $(BCHGCC_H) $(BCHDRN_H)
+bchpur.$(OBJ): bchpur.c $(SCHEME_H) $(PRIMS_H) $(BCHGCC_H) $(ZONES_H)
+bchutl.$(OBJ): bchutl.c $(CONFIG_H)
+
+os2.$(OBJ): os2.c $(OS2_H)
+os2conio.$(OBJ): os2conio.c $(OS2_H)
+os2cthrd.$(OBJ): os2cthrd.c $(OS2_H)
+os2ctty.$(OBJ): os2ctty.c $(OS2_H) $(OSCTTY_H) $(OSSIG_H)
+os2env.$(OBJ): os2env.c $(SCHEME_H) $(OS2_H) $(OSENV_H)
+os2file.$(OBJ): os2file.c $(OS2_H) $(OSFILE_H)
+os2fs.$(OBJ): os2fs.c $(OS2_H) $(OSFS_H)
+os2io.$(OBJ): os2io.c $(OS2_H)
+os2msg.$(OBJ): os2msg.c $(OS2_H)
+os2pipe.$(OBJ): os2pipe.c $(OS2_H)
+os2pm.$(OBJ): os2pm.c $(OS2_H) os2pm-id.h os2pm-mi.h os2pm-dc.h os2pm-rp.h
+os2pmcon.$(OBJ): os2pmcon.c $(OS2_H) $(OS2PMCON_H) $(VERSION_H)
+os2proc.$(OBJ): os2proc.c $(OS2_H) $(OSPROC_H) $(OSENV_H)
+os2sock.$(OBJ): os2sock.c $(SCHEME_H) $(PRIMS_H) $(OSSCHEME_H) $(OS2_H) \
+ $(UXSOCK_H)
+os2term.$(OBJ): os2term.c $(OS2_H) $(PRIMS_H)
+os2thrd.$(OBJ): os2thrd.c $(OS2_H) $(PRIMS_H) $(ERRORS_H)
+os2top.$(OBJ): os2top.c $(SCHEME_H) $(OS2_H) $(OSTOP_H) $(OPTION_H)
+os2tty.$(OBJ): os2tty.c $(OS2_H) $(OSTTY_H)
+os2xcpt.$(OBJ): os2xcpt.c $(SCHEME_H) $(GCCODE_H) $(OS2_H)
+
+missing.$(OBJ): missing.c $(CONFIG_H)
+
+findprim.$(OBJ): findprim.c $(CONFIG_H)
+
+bintopsb.$(OBJ): bintopsb.c $(PSBMAP_H) $(LIMITS_H) $(LOAD_C) $(BLTDEF_H) \
+ $(TRAP_H)
+psbtobin.$(OBJ): psbtobin.c $(PSBMAP_H) $(FLOAT_H) $(LIMITS_H) $(FASL_H) \
+ $(DUMP_C)
### -*- Fundamental -*-
###
-### $Id: makefile.emx,v 1.8 1999/01/02 06:11:34 cph Exp $
+### $Id: makefile.emx,v 1.9 2000/12/05 21:23:51 cph Exp $
###
-### Copyright (c) 1994-1999 Massachusetts Institute of Technology
+### Copyright (c) 1994-2000 Massachusetts Institute of Technology
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License as
include os2utl\makefile.cmn
-scheme.exe : $(OBJECTS) $(SCHEME_OBJECTS) scheme.res
- $(CC) $(LDFLAGS) -o $(basename $@) \
- $(OBJECTS) $(SCHEME_OBJECTS) $(SCHEME_LIB)
+scheme.exe : $(OBJECTS) scheme.res
+ $(CC) $(LDFLAGS) -o $(basename $@) $(OBJECTS) $(SCHEME_LIB)
emxbind -b -p -q -r$(basename $@).res $(basename $@)
del $(basename $@)
-bchschem.exe : $(BCHOBJECTS) $(SCHEME_OBJECTS) bchschem.res
- $(CC) $(LDFLAGS) -o $(basename $@) \
- $(OBJECTS) $(SCHEME_OBJECTS) $(SCHEME_LIB)
+bchschem.exe : $(BCHOBJECTS) bchschem.res
+ $(CC) $(LDFLAGS) -o $(basename $@) $(BCHOBJECTS) $(SCHEME_LIB)
emxbind -b -p -q -r$(basename $@).res $(basename $@)
del $(basename $@)
### -*- Fundamental -*-
###
-### $Id: makefile.gcc,v 1.6 1999/01/02 06:11:34 cph Exp $
+### $Id: makefile.gcc,v 1.7 2000/12/05 21:23:51 cph Exp $
###
-### Copyright (c) 1995, 1999 Massachusetts Institute of Technology
+### Copyright (c) 1995, 1999, 2000 Massachusetts Institute of Technology
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License as
include os2utl\makefile.cmn
-scheme.exe : $(OBJECTS) $(SCHEME_OBJECTS) scheme.res
+scheme.exe : $(OBJECTS) scheme.res
$(CC) $(LDFLAGS) -o $@ $^ $(SCHEME_LIB)
rc scheme.res $@
-bchschem.exe : $(BCHOBJECTS) $(SCHEME_OBJECTS) bchschem.res
+bchschem.exe : $(BCHOBJECTS) bchschem.res
$(CC) $(LDFLAGS) -o $@ $^ $(SCHEME_LIB)
rc bchschem.res $@
### -*- Fundamental -*-
###
-### $Id: makefile.vac,v 1.6 1999/01/02 06:11:34 cph Exp $
+### $Id: makefile.vac,v 1.7 2000/12/05 21:23:51 cph Exp $
###
-### Copyright (c) 1994-1999 Massachusetts Institute of Technology
+### Copyright (c) 1994-2000 Massachusetts Institute of Technology
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License as
# included with the EMX/GCC package, and the RC program included with
# the IBM OS/2 Toolkit.
-ICCFLAGS := /Gm+ /Q+ /Wall-
+ICCFLAGS := /Gm+ /Q+ /W2 /Wall+
ifeq ($(debug_mode),debug)
ICCFLAGS := $(ICCFLAGS) /Ti+
else
include os2utl\makefile.cmn
-scheme.exe : $(OBJECTS) $(SCHEME_OBJECTS) scheme.res
- $(CC) $(LDFLAGS) /B"/PMTYPE:PM" /Fe$@ \
- $(OBJECTS) $(SCHEME_OBJECTS) $(SCHEME_LIB)
+scheme.exe : $(OBJECTS) scheme.res
+ $(CC) $(LDFLAGS) /B"/PMTYPE:PM" /Fe$@ $(OBJECTS) $(SCHEME_LIB)
rc scheme.res $@
-bchschem.exe : $(BCHOBJECTS) $(SCHEME_OBJECTS) bchschem.res
- $(CC) $(LDFLAGS) /B"/PMTYPE:PM" /Fe$@ \
- $(OBJECTS) $(SCHEME_OBJECTS) $(SCHEME_LIB)
+bchschem.exe : $(BCHOBJECTS) bchschem.res
+ $(CC) $(LDFLAGS) /B"/PMTYPE:PM" /Fe$@ $(BCHOBJECTS) $(SCHEME_LIB)
rc bchschem.res $@
### -*- Fundamental -*-
###
-### $Id: makefile.wcc,v 1.7 1999/01/02 06:11:34 cph Exp $
+### $Id: makefile.wcc,v 1.8 2000/12/05 21:23:51 cph Exp $
###
-### Copyright (c) 1994-1999 Massachusetts Institute of Technology
+### Copyright (c) 1994-2000 Massachusetts Institute of Technology
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License as
cmpauxmd.asm : cmpauxmd.m4 asmcvt.exe
.\asmcvt pre < $< | $(M4) $(M4FLAGS) | .\asmcvt post > $@
-scheme.exe : $(OBJECTS) $(SCHEME_OBJECTS) scheme.res
+scheme.exe : $(OBJECTS) scheme.res
wlink system os2v2_pm name $@ $(LDFLAGS) \
- file { $(OBJECTS) $(SCHEME_OBJECTS) } $(SCHEME_LIB)
+ file { $(OBJECTS) } $(SCHEME_LIB)
rc scheme.res $@
-bchschem.exe : $(BCHOBJECTS) $(SCHEME_OBJECTS) bchschem.res
+bchschem.exe : $(BCHOBJECTS) bchschem.res
wlink system os2v2_pm name $@ $(LDFLAGS) \
- file { $(OBJECTS) $(SCHEME_OBJECTS) } $(SCHEME_LIB)
+ file { $(BCHOBJECTS) } $(SCHEME_LIB)
rc bchschem.res $@
--- /dev/null
+#| -*-Scheme-*-
+
+$Id: mkos2pm.scm,v 1.2 2000/12/05 21:23:51 cph Exp $
+
+Copyright (c) 2000 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+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, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+(load "os2pm.scm")
\ No newline at end of file
/* -*-C-*-
-$Id: os2xcpt.c,v 1.7 1999/01/02 06:11:34 cph Exp $
+$Id: os2xcpt.c,v 1.8 2000/12/05 21:23:46 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
extern int pc_to_builtin_index (unsigned long);
extern SCHEME_OBJECT * find_constant_space_block (SCHEME_OBJECT *);
extern int OS2_disable_stack_guard (void *);
+extern int OS2_essential_thread_p (TID);
+extern void OS2_message_box (const char *, const char *, int);
extern ULONG C_Stack_Pointer;
extern ULONG C_Frame_Pointer;
/* -*-C-*-
-$Id: osenv.h,v 1.9 2000/01/18 05:08:46 cph Exp $
+$Id: osenv.h,v 1.10 2000/12/05 21:23:47 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
int time_zone;
};
-extern time_t EXFUN (OS_encoded_time, ());
+extern time_t EXFUN (OS_encoded_time, (void));
extern void EXFUN (OS_decode_time, (time_t, struct time_structure *));
extern void EXFUN (OS_decode_utc, (time_t, struct time_structure *));
extern time_t EXFUN (OS_encode_time, (struct time_structure *));
/* -*-C-*-
-$Id: osfs.h,v 1.8 1999/12/21 18:48:47 cph Exp $
+$Id: osfs.h,v 1.9 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
(OS_file_link_soft, (CONST char * from_name, CONST char * to_name));
extern void EXFUN (OS_directory_make, (CONST char * name));
extern void EXFUN (OS_directory_delete, (CONST char * name));
+extern int EXFUN (OS_file_touch, (CONST char *));
extern unsigned int EXFUN (OS_directory_open, (CONST char * name));
extern int EXFUN (OS_directory_valid_p, (long index));
extern void EXFUN (OS_directory_close, (unsigned int index));
/* -*-C-*-
-$Id: osio.h,v 1.14 1999/01/02 06:11:34 cph Exp $
+$Id: osio.h,v 1.15 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
extern void EXFUN (OS_channel_nonblocking, (Tchannel channel));
extern void EXFUN (OS_channel_blocking, (Tchannel channel));
-#ifdef WINNT
+#ifdef __WIN32__
extern int OS_have_select_p;
#else
extern CONST int OS_have_select_p;
/* -*-C-*-
-$Id: osscheme.c,v 1.10 1999/01/02 06:11:34 cph Exp $
+$Id: osscheme.c,v 1.11 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
*/
#include "scheme.h"
-#include "osscheme.h"
#include "prims.h"
+#include "osscheme.h"
\f
extern void
EXFUN (signal_error_from_primitive, (long error_code));
return (PRIMITIVE_P (Regs [REGBLOCK_PRIMITIVE]));
}
-#ifdef _OS2
+#ifdef __OS2__
void
DEFUN_VOID (request_attention_interrupt)
return ((code & INT_Global_1) != 0);
}
-#endif /* _OS2 */
+#endif /* __OS2__ */
void
DEFUN_VOID (request_character_interrupt)
/* -*-C-*-
-$Id: osscheme.h,v 1.10 1999/01/02 06:11:34 cph Exp $
+$Id: osscheme.h,v 1.11 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
extern void EXFUN (termination_signal, (CONST char * signal_name));
extern void EXFUN (termination_trap, (void));
-#ifdef _OS2
+#ifdef __OS2__
extern void EXFUN (request_attention_interrupt, (void));
extern int EXFUN (test_and_clear_attention_interrupt, (void));
-#endif /* _OS2 */
+#endif /* __OS2__ */
extern void EXFUN (request_character_interrupt, (void));
extern void EXFUN (request_timer_interrupt, (void));
/* -*-C-*-
-$Id: outf.c,v 1.11 1999/01/02 06:11:34 cph Exp $
+$Id: outf.c,v 1.12 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
information to stay visible `after' the termination of Scheme.
*/
-#if defined(__STDC__) || defined(WINNT) || defined(__IBMC__) || defined(_MSC_VER)
-#include <stdarg.h>
-#define VA_START(args, lastarg) va_start(args, lastarg)
-#define VA_DCL
-#else
-#include <varargs.h>
-#define VA_START(args, lastarg) va_start(args)
-#define VA_DCL va_dcl
-#endif
-
#include <stdio.h>
#include "scheme.h"
-#ifdef WINNT
-#include <windows.h>
-#include "ntscreen.h"
+#ifdef STDC_HEADERS
+# include <string.h>
+# include <stdarg.h>
+# define VA_START(args, lastarg) va_start(args, lastarg)
+# define VA_DCL
+#else
+# include <varargs.h>
+# define VA_START(args, lastarg) va_start(args)
+# define VA_DCL va_dcl
+#endif
+
+#ifdef __WIN32__
+# include <windows.h>
+# include "ntscreen.h"
#endif
/* forward reference */
return (FILE*)chan;
}
\f
-#ifdef WINNT
+#ifdef __WIN32__
#define USE_WINDOWED_OUTPUT
-static int max_fatal_buf = 1000;
-static char fatal_buf[1000+1] = {0};
+#define MAX_FATAL_BUF 1000
+static char fatal_buf[MAX_FATAL_BUF + 1] = {0};
#ifdef CL386
-#define VSNPRINTF(buffer,length,format,args) \
- _vsnprintf ((buffer), (length), (format), (args))
+# define VSNPRINTF(buffer,length,format,args) \
+ _vsnprintf ((buffer), (length), (format), (args))
#else
-#ifdef __WATCOMC__
-#define VSNPRINTF(buffer,length,format,args) \
- vsprintf ((buffer), (format), (args))
-#endif
+# ifdef __WATCOMC__
+# define VSNPRINTF(buffer,length,format,args) \
+ vsprintf ((buffer), (format), (args))
+# endif
#endif
void
DEFUN (voutf_fatal, (format, args), CONST char *format AND va_list args)
{
int end = strlen(fatal_buf);
- VSNPRINTF (&fatal_buf[end], max_fatal_buf - end, format, args);
+ VSNPRINTF (&fatal_buf[end], MAX_FATAL_BUF - end, format, args);
}
void
}
}
-#else /* not WINNT */
-#ifdef _OS2
+#else /* not __WIN32__ */
+#ifdef __OS2__
extern char * OS2_thread_fatal_error_buffer (void);
extern void OS2_message_box (const char *, const char *, int);
OS2_console_write (buffer, (strlen (buffer)));
}
-#endif /* _OS2 */
-#endif /* not WINNT */
+#endif /* __OS2__ */
+#endif /* not __WIN32__ */
\f
void
DEFUN (voutf, (chan, format, ap),
/* -*-C-*-
-$Id: outf.h,v 1.4 1999/01/02 06:11:34 cph Exp $
+$Id: outf.h,v 1.5 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1993, 1999 Massachusetts Institute of Technology
+Copyright (c) 1993, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#define SCM_OUTF_H
#include <stdio.h>
-#include "ansidecl.h"
+#include "config.h"
typedef struct __outf_channel_type_placeholder *outf_channel;
/* -*-C-*-
-$Id: ppband.c,v 9.49 1999/01/02 06:06:43 cph Exp $
+$Id: ppband.c,v 9.50 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include <stdio.h>
#include <ctype.h>
-#include "ansidecl.h"
#include "config.h"
#include "errors.h"
#include "types.h"
#include "load.c"
\f
#ifdef HEAP_IN_LOW_MEMORY
-#ifdef hp9000s800
+#if defined(hp9000s800) || defined(__hp9000s800)
# define File_To_Pointer(P) \
((((long) (P)) & DATUM_MASK) / (sizeof (SCHEME_OBJECT)))
#else
/* -*-C-*-
-$Id: prbfish.c,v 1.8 1999/08/13 18:42:26 cph Exp $
+$Id: prbfish.c,v 1.9 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1997, 1999 Massachusetts Institute of Technology
+Copyright (c) 1997, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Returned value is the new value of NUM.")
{
SCHEME_OBJECT input_text;
- unsigned long l;
unsigned long istart;
unsigned long iend;
unsigned long ilen;
Returned value is the new value of NUM.")
{
SCHEME_OBJECT input_text;
- unsigned long l;
unsigned long istart;
unsigned long iend;
unsigned long ilen;
/* -*-C-*-
-$Id: primutl.c,v 9.72 2000/01/18 05:08:57 cph Exp $
+$Id: primutl.c,v 9.73 2000/12/05 21:23:47 cph Exp $
Copyright (c) 1988-2000 Massachusetts Institute of Technology
*/
#include "scheme.h"
-#include "os.h"
#include "prims.h"
+#include "os.h"
#include "usrdef.h"
#include "prename.h"
#include "syscall.h"
#include "cmpgc.h"
#include <ctype.h>
+extern PTR EXFUN (malloc, (size_t));
+extern PTR EXFUN (realloc, (PTR, size_t));
+
+#ifdef STDC_HEADERS
+# include <string.h>
+#else
+ extern PTR EXFUN (memcpy, (PTR, CONST PTR, size_t));
+ extern char * EXFUN (strcpy, (char *, CONST char *));
+#endif
+
extern SCHEME_OBJECT * load_renumber_table;
#ifndef UPDATE_PRIMITIVE_TABLE_HOOK
return ((diff == 0) ? 0 : ((diff > 0) ? 1 : -1));
}
-extern PTR EXFUN (malloc, (size_t));
-extern PTR EXFUN (realloc, (PTR, size_t));
-extern PTR EXFUN (memcpy, (PTR, CONST PTR, size_t));
-extern char * EXFUN (strcpy, (char *, CONST char *));
-
SCHEME_OBJECT
DEFUN_VOID (Prim_unimplemented)
{
/* -*-C-*-
-$Id: prmcon.h,v 1.3 1999/01/02 06:11:34 cph Exp $
+$Id: prmcon.h,v 1.4 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1990, 1999 Massachusetts Institute of Technology
+Copyright (c) 1990, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#ifdef SCM_PRMCON_C
-SCHEME_OBJECT EXFUN (continue_fasload, (SCHEME_OBJECT *reentry_record));
+SCHEME_OBJECT EXFUN (continue_fasload, (SCHEME_OBJECT *));
-static
-SCHEME_OBJECT (* (continuation_procedures []))() = {
+static SCHEME_OBJECT EXFUN
+ ((* (continuation_procedures [])), (SCHEME_OBJECT *)) = {
continue_fasload
};
/* -*-C-*-
-$Id: prntenv.c,v 1.9 1999/03/09 05:38:59 cph Exp $
+$Id: prntenv.c,v 1.10 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
*/
/* Unix-specific process-environment primitives. */
-/* DOS imitation */
+/* Win32 imitation */
#include "scheme.h"
#include "prims.h"
/* -*-C-*-
-$Id: prntfs.c,v 1.15 1999/01/02 06:11:34 cph Exp $
+$Id: prntfs.c,v 1.16 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
extern void EXFUN (OS_file_copy, (CONST char *, CONST char *));
extern int win32_directory_read (unsigned int, WIN32_FIND_DATA *);
-
-static SCHEME_OBJECT file_attributes_internal
- (DWORD, FILETIME *, FILETIME *, FILETIME *, DWORD, DWORD);
-static SCHEME_OBJECT EXFUN (file_touch, (CONST char * filename));
-static void EXFUN (protect_fd, (int fd));
-
-#ifndef FILE_TOUCH_OPEN_TRIES
-#define FILE_TOUCH_OPEN_TRIES 5
-#endif
\f
static double ut_zero = 0.0;
}
}
\f
-DEFINE_PRIMITIVE ("FILE-TOUCH", Prim_file_touch, 1, 1,
- "Given a file name, change the times of the file to the current time.\n\
-If the file does not exist, create it.\n\
-Both the access time and modification time are changed.\n\
-Return #F if the file existed and its time was modified.\n\
-Otherwise the file did not exist and it was created.")
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (file_touch ((CONST char *) (STRING_ARG (1))));
-}
-
-
-static SCHEME_OBJECT
-DEFUN (file_touch, (filename), CONST char * filename)
-{
- int fd;
- transaction_begin ();
- {
- unsigned int count = 0;
- while (1)
- {
- count += 1;
- /* Use O_EXCL to prevent overwriting existing file. */
- fd = (open (filename, (O_RDWR | O_CREAT | O_EXCL), MODE_REG));
- if (fd >= 0)
- {
- protect_fd (fd);
- transaction_commit ();
- return (SHARP_T);
- }
- if (errno == EEXIST)
- {
- fd = (open (filename, O_RDWR, MODE_REG));
- if (fd >= 0)
- {
- protect_fd (fd);
- break;
- }
- else if (errno == ENOENT)
- continue;
- }
- if (count >= FILE_TOUCH_OPEN_TRIES)
- NT_error_unix_call (errno, syscall_open);
- }
- }
- {
- struct stat file_status;
- STD_VOID_UNIX_CALL (fstat, (fd, (&file_status)));
- if (((file_status . st_mode) & S_IFMT) != S_IFREG)
- error_bad_range_arg (1);
- /* CASE 3: file length of 0 needs special treatment. */
- if ((file_status . st_size) == 0)
- {
- char buf [1];
- (buf[0]) = '\0';
- STD_VOID_UNIX_CALL (write, (fd, buf, 1));
-#ifdef HAVE_TRUNCATE
- STD_VOID_UNIX_CALL (ftruncate, (fd, 0));
- transaction_commit ();
-#else /* not HAVE_TRUNCATE */
- transaction_commit ();
- fd = (open (filename, (O_WRONLY | O_TRUNC), MODE_REG));
- if (fd >= 0)
- STD_VOID_UNIX_CALL (close, (fd));
-#endif /* HAVE_TRUNCATE */
- return (SHARP_F);
- }
- }
- /* CASE 4: read, then write back the first byte in the file. */
- {
- char buf [1];
- int scr;
- STD_UINT_UNIX_CALL (scr, read, (fd, buf, 1));
- if (scr > 0)
- {
- STD_VOID_UNIX_CALL (lseek, (fd, 0, SEEK_SET));
- STD_VOID_UNIX_CALL (write, (fd, buf, 1));
- }
- }
- transaction_commit ();
- return (SHARP_F);
-}
-
-static void
-DEFUN (protect_fd_close, (ap), PTR ap)
-{
- close (* ((int *) ap));
-}
-
-static void
-DEFUN (protect_fd, (fd), int fd)
-{
- int * p = (dstack_alloc (sizeof (int)));
- (*p) = fd;
- transaction_record_action (tat_always, protect_fd_close, p);
-}
-\f
DEFINE_PRIMITIVE ("FILE-EQ?", Prim_file_eq_p, 2, 2,
"True iff the two file arguments are the same file.")
{
/* -*-C-*-
-$Id: prntio.c,v 1.12 2000/04/19 03:21:09 cph Exp $
+$Id: prntio.c,v 1.13 2000/12/05 21:23:47 cph Exp $
Copyright (c) 1993-2000 Massachusetts Institute of Technology
{
PRIMITIVE_HEADER (2);
{
- unsigned long old_level = win32_trace_level;
win32_trace_level = (arg_ulong_integer (1));
if (win32_trace_file != 0)
{
/* -*-C-*-
-$Id: pros2fs.c,v 1.17 1999/01/02 06:11:34 cph Exp $
+$Id: pros2fs.c,v 1.18 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
extern long OS2_daylight_savings_p (void);
extern void EXFUN (OS_file_copy, (CONST char *, CONST char *));
-#ifndef FILE_TOUCH_OPEN_TRIES
-#define FILE_TOUCH_OPEN_TRIES 5
-#endif
-
static SCHEME_OBJECT time_to_integer (FDATE *, FTIME *);
static void integer_to_time (SCHEME_OBJECT, FDATE *, FTIME *);
-static SCHEME_OBJECT file_touch (const char *);
-static void protect_handle (LHANDLE);
\f
DEFINE_PRIMITIVE ("FILE-ATTRIBUTES", Prim_file_attributes, 1, 1,
"Return attributes of FILE, as an integer.")
(date -> year) = accum;
}
\f
-DEFINE_PRIMITIVE ("FILE-TOUCH", Prim_file_touch, 1, 1,
- "Given a file name, change the times of the file to the current time.\n\
-If the file does not exist, create it.\n\
-Both the access time and modification time are changed.\n\
-Return #F if the file existed and its time was modified.\n\
-Otherwise the file did not exist and it was created.")
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (file_touch ((CONST char *) (STRING_ARG (1))));
-}
-
-static SCHEME_OBJECT
-file_touch (const char * filename)
-{
- HFILE handle;
- ULONG action;
- APIRET rc;
- unsigned int count = 0;
-
- transaction_begin ();
- while (1)
- {
- APIRET rc
- = (dos_open (((char *) filename),
- (&handle),
- (&action),
- 0,
- FILE_NORMAL,
- (OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_CREATE_IF_NEW),
- (OPEN_ACCESS_READWRITE | OPEN_SHARE_DENYREADWRITE),
- 0));
- if (rc == NO_ERROR)
- break;
- if ((rc != NO_ERROR)
- && (rc != ERROR_FILE_NOT_FOUND)
- && (rc != ERROR_PATH_NOT_FOUND)
- && ((++ count) >= FILE_TOUCH_OPEN_TRIES))
- OS2_error_system_call (rc, syscall_dos_open);
- }
- protect_handle (handle);
- if (action == FILE_CREATED)
- {
- transaction_commit ();
- return (SHARP_T);
- }
- /* Existing file -- we'll write something to it to make sure that it
- has its times updated properly upon close. This was needed for
- unix implementation, but it is not known whether it is needed in
- OS/2. In any case, it does no harm to do this. */
- {
- FILESTATUS3 info;
- char buffer [1];
- ULONG n;
- STD_API_CALL (dos_query_file_info,
- (handle, FIL_STANDARD, (& info), (sizeof (info))));
- if ((info . cbFile) == 0)
- {
- /* Zero-length file: write a byte, then reset the length. */
- (buffer[0]) = '\0';
- STD_API_CALL (dos_write, (handle, buffer, 1, (& n)));
- STD_API_CALL (dos_set_file_size, (handle, 0));
- }
- else
- {
- /* Read the first byte, then write it back in place. */
- STD_API_CALL (dos_read, (handle, buffer, 1, (&n)));
- STD_API_CALL (dos_set_file_ptr, (handle, 0, FILE_BEGIN, (& n)));
- STD_API_CALL (dos_write, (handle, buffer, 1, (& n)));
- }
- }
- transaction_commit ();
- return (SHARP_F);
-}
-
-static void
-protect_handle_1 (void * hp)
-{
- (void) dos_close (* ((LHANDLE *) hp));
-}
-
-static void
-protect_handle (LHANDLE h)
-{
- LHANDLE * hp = (dstack_alloc (sizeof (LHANDLE)));
- (*hp) = h;
- transaction_record_action (tat_always, protect_handle_1, hp);
-}
-\f
DEFINE_PRIMITIVE ("FILE-INFO", Prim_file_info, 1, 1,
"Given a file name, return information about the file.\n\
If the file exists and its information is accessible,\n\
/* -*-C-*-
-$Id: pros2io.c,v 1.8 1999/01/02 06:11:34 cph Exp $
+$Id: pros2io.c,v 1.9 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "scheme.h"
#include "prims.h"
#include "os2.h"
-#include "osproc.h"
+#include "os2proc.h"
extern qid_t OS2_channel_thread_descriptor (Tchannel);
\f
/* -*-C-*-
-$Id: prosenv.c,v 1.16 1999/04/07 04:01:46 cph Exp $
+$Id: prosenv.c,v 1.17 2000/12/05 21:23:47 cph Exp $
Copyright (c) 1987-1999 Massachusetts Institute of Technology
FAST_VECTOR_SET (vec, 6, (ulong_to_integer (ts . year))); \
FAST_VECTOR_SET (vec, 7, (ulong_to_integer (ts . day_of_week))); \
FAST_VECTOR_SET \
- (vec, 8, (ulong_to_integer (ts . daylight_savings_time))); \
+ (vec, 8, \
+ (((ts . daylight_savings_time) < 0) \
+ ? SHARP_F \
+ : (long_to_integer (ts . daylight_savings_time)))); \
FAST_VECTOR_SET \
(vec, 9, \
(((ts . time_zone) == INT_MAX) \
? SHARP_F \
- : (ulong_to_integer (ts . time_zone)))); \
+ : (long_to_integer (ts . time_zone)))); \
} \
PRIMITIVE_RETURN (UNSPECIFIC); \
}
(ts . year) = (integer_to_ulong (FAST_VECTOR_REF (vec, 6)));
(ts . day_of_week) = (integer_to_ulong (FAST_VECTOR_REF (vec, 7)));
(ts . daylight_savings_time)
- = ((len > 8)
- ? (integer_to_ulong (FAST_VECTOR_REF (vec, 8)))
+ = (((len > 8) && (INTEGER_P (FAST_VECTOR_REF (vec, 8))))
+ ? (integer_to_long (FAST_VECTOR_REF (vec, 8)))
: (-1));
(ts . time_zone)
= (((len > 9)
/* -*-C-*-
-$Id: prosfs.c,v 1.14 1999/12/21 18:48:29 cph Exp $
+$Id: prosfs.c,v 1.15 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "osfile.h"
#include "osfs.h"
#include "osio.h"
-#ifdef DOS386
-# include <sys\stat.h>
-#endif
extern int EXFUN (OS_channel_copy,
(off_t source_length,
OS_directory_delete (STRING_ARG (1));
PRIMITIVE_RETURN (UNSPECIFIC);
}
+
+DEFINE_PRIMITIVE ("FILE-TOUCH", Prim_file_touch, 1, 1,
+ "Given a file name, change the times of the file to the current time.\n\
+If the file does not exist, create it.\n\
+Both the access time and modification time are changed.\n\
+Return #F if the file existed and its time was modified.\n\
+Otherwise the file did not exist and it was created.")
+{
+ PRIMITIVE_HEADER (1);
+ PRIMITIVE_RETURN
+ (BOOLEAN_TO_OBJECT (OS_file_touch ((CONST char *) (STRING_ARG (1)))));
+}
\f
DEFINE_PRIMITIVE ("NEW-DIRECTORY-OPEN", Prim_new_directory_open, 1, 1,
"Open the directory NAME for reading, returning a directory number.")
/* -*-C-*-
-$Id: prosproc.c,v 1.18 1999/01/02 06:11:34 cph Exp $
+$Id: prosproc.c,v 1.19 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "scheme.h"
#include "prims.h"
#include "osproc.h"
+#include "osio.h"
+
+#ifdef __unix__
+ extern char ** environ;
+#endif
extern Tchannel EXFUN (arg_channel, (int));
return (process);
}
\f
-#if defined(_OS2) && defined(__IBMC__)
-#define environ _environ
-#endif
-
DEFINE_PRIMITIVE ("SCHEME-ENVIRONMENT", Prim_scheme_environment, 0, 0, 0)
{
PRIMITIVE_HEADER (0);
{
- extern char ** environ;
+ char ** scan_environ = environ;
+ char ** end_environ = scan_environ;
+ while ((*end_environ++) != 0) ;
+ end_environ -= 1;
{
- char ** scan_environ = environ;
- char ** end_environ = scan_environ;
- while ((*end_environ++) != 0) ;
- end_environ -= 1;
- {
- SCHEME_OBJECT result =
- (allocate_marked_vector (TC_VECTOR, (end_environ - environ), 1));
- SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
- while (scan_environ < end_environ)
- (*scan_result++) =
- (char_pointer_to_string ((unsigned char *) (*scan_environ++)));
- PRIMITIVE_RETURN (result);
- }
+ SCHEME_OBJECT result =
+ (allocate_marked_vector (TC_VECTOR, (end_environ - environ), 1));
+ SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
+ while (scan_environ < end_environ)
+ (*scan_result++) =
+ (char_pointer_to_string ((unsigned char *) (*scan_environ++)));
+ PRIMITIVE_RETURN (result);
}
}
}
enum process_ctty_type ctty_type;
char * ctty_name = 0;
enum process_channel_type channel_in_type;
- Tchannel channel_in;
+ Tchannel channel_in = NO_CHANNEL;
enum process_channel_type channel_out_type;
- Tchannel channel_out;
+ Tchannel channel_out = NO_CHANNEL;
enum process_channel_type channel_err_type;
- Tchannel channel_err;
+ Tchannel channel_err = NO_CHANNEL;
if ((PAIR_P (env_object)) && (STRING_P (PAIR_CDR (env_object))))
{
/* -*-C-*-
-$Id: pruxdld.c,v 1.12 1999/01/02 06:11:34 cph Exp $
+$Id: pruxdld.c,v 1.13 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
}
\f
#else /* not _AIX */
-#if defined(_HPUX)
+#if defined(__HPUX__)
#include <dl.h>
AND int type
AND PTR * result)
{
-#ifndef hp9000s300
+#if !(defined(hp9000s300) || defined(__hp9000s300))
return (shl_findsym (handle, symbol, type, result));
#else
/* External symbols on the 300s often have underscores.
#endif
}
\f
-#else /* not _HPUX */
+#else /* not __HPUX__ */
#include <dlfcn.h>
: 0);
}
-#endif /* _HPUX */
+#endif /* __HPUX__ */
#endif /* _AIX */
\f
DEFINE_PRIMITIVE ("LOAD-OBJECT-FILE", Prim_load_object_file, 1, 1,
/* -*-C-*-
-$Id: pruxenv.c,v 1.18 1999/01/02 06:11:34 cph Exp $
+$Id: pruxenv.c,v 1.19 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "ux.h"
#ifdef HAVE_SOCKETS
-#include "uxsock.h"
-#include <sys/socket.h>
-#include <netinet/in.h>
-#include <netdb.h>
+# include "uxsock.h"
#endif
-
-extern char ** environ;
\f
DEFINE_PRIMITIVE ("FILE-TIME->STRING", Prim_file_time_to_string, 1, 1,
"Convert a file system time stamp into a date/time string.")
(char_pointer_to_string ((unsigned char *)
OS_current_user_home_directory ()));
}
-\f
+
DEFINE_PRIMITIVE ("SYSTEM", Prim_system, 1, 1,
"Invoke sh (the Bourne shell) on the string argument.\n\
Wait until the shell terminates, returning its exit status as an integer.")
PRIMITIVE_RETURN (long_to_integer (UX_system (STRING_ARG (1))));
}
-DEFINE_PRIMITIVE ("UNIX-ENVIRONMENT", Prim_unix_environment_alist, 0, 0,
- "Copy the unix environment and return it as a vector of strings.")
-{
- PRIMITIVE_HEADER (0);
- {
- char ** scan = environ;
- char ** end = scan;
- while ((*end++) != 0);
- end -= 1;
- {
- SCHEME_OBJECT result =
- (allocate_marked_vector (TC_VECTOR, (end - scan), 1));
- SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
- while (scan < end)
- (*scan_result++) =
- (char_pointer_to_string ((unsigned char *) (*scan++)));
- PRIMITIVE_RETURN (result);
- }
- }
-}
-
DEFINE_PRIMITIVE ("GET-ENVIRONMENT-VARIABLE", Prim_get_environment_variable, 1, 1,
"Look up the value of a variable in the user's shell environment.\n\
The argument, a variable name, must be a string.\n\
/* -*-C-*-
-$Id: pruxfs.c,v 9.55 1999/01/02 06:11:34 cph Exp $
+$Id: pruxfs.c,v 9.56 2000/12/05 21:23:47 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
static void EXFUN (file_mode_string, (struct stat * s, char * a));
static char EXFUN (file_type_letter, (struct stat * s));
static void EXFUN (rwx, (unsigned short bits, char * chars));
-static SCHEME_OBJECT EXFUN (file_touch, (CONST char * filename));
-static void EXFUN (protect_fd, (int fd));
-
-#ifndef FILE_TOUCH_OPEN_TRIES
-#define FILE_TOUCH_OPEN_TRIES 5
-#endif
\f
DEFINE_PRIMITIVE ("FILE-MODES", Prim_file_modes, 1, 1,
"Return mode bits of FILE, as an integer.")
static void
DEFUN (rwx, (bits, chars), unsigned short bits AND char * chars)
{
- (chars[0]) = (((bits & S_IREAD) != 0) ? 'r' : '-');
- (chars[1]) = (((bits & S_IWRITE) != 0) ? 'w' : '-');
- (chars[2]) = (((bits & S_IEXEC) != 0) ? 'x' : '-');
-}
-\f
-DEFINE_PRIMITIVE ("FILE-TOUCH", Prim_file_touch, 1, 1,
- "Given a file name, change the times of the file to the current time.\n\
-If the file does not exist, create it.\n\
-Both the access time and modification time are changed.\n\
-Return #F if the file existed and its time was modified.\n\
-Otherwise the file did not exist and it was created.")
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (file_touch ((CONST char *) (STRING_ARG (1))));
-}
-
-static SCHEME_OBJECT
-DEFUN (file_touch, (filename), CONST char * filename)
-{
- int fd;
- transaction_begin ();
- {
- unsigned int count = 0;
- while (1)
- {
- count += 1;
- /* Use O_EXCL to prevent overwriting existing file. */
- fd = (UX_open (filename, (O_RDWR | O_CREAT | O_EXCL), MODE_REG));
- if (fd >= 0)
- {
- protect_fd (fd);
- transaction_commit ();
- return (SHARP_T);
- }
- if (errno == EEXIST)
- {
- fd = (UX_open (filename, O_RDWR, MODE_REG));
- if (fd >= 0)
- {
- protect_fd (fd);
- break;
- }
- else if ((errno == ENOENT)
-#ifdef ESTALE
- || (errno == ESTALE)
-#endif
- )
- continue;
- }
- if (count >= FILE_TOUCH_OPEN_TRIES)
- error_system_call (errno, syscall_open);
- }
- }
- {
- struct stat file_status;
- STD_VOID_SYSTEM_CALL (syscall_fstat, (UX_fstat (fd, (&file_status))));
- if (((file_status . st_mode) & S_IFMT) != S_IFREG)
- error_bad_range_arg (1);
- /* CASE 3: file length of 0 needs special treatment. */
- if ((file_status . st_size) == 0)
- {
- char buf [1];
- (buf[0]) = '\0';
- STD_VOID_SYSTEM_CALL (syscall_write, (UX_write (fd, buf, 1)));
-#ifdef HAVE_TRUNCATE
- STD_VOID_SYSTEM_CALL (syscall_ftruncate, (UX_ftruncate (fd, 0)));
- transaction_commit ();
-#else /* not HAVE_TRUNCATE */
- transaction_commit ();
- fd = (UX_open (filename, (O_WRONLY | O_TRUNC), MODE_REG));
- if (fd >= 0)
- STD_VOID_SYSTEM_CALL (syscall_close, (UX_close (fd)));
-#endif /* HAVE_TRUNCATE */
- return (SHARP_F);
- }
- }
- /* CASE 4: read, then write back the first byte in the file. */
- {
- char buf [1];
- int scr;
- STD_UINT_SYSTEM_CALL (syscall_read, scr, (UX_read (fd, buf, 1)));
- if (scr > 0)
- {
- STD_VOID_SYSTEM_CALL (syscall_lseek, (UX_lseek (fd, 0, SEEK_SET)));
- STD_VOID_SYSTEM_CALL (syscall_write, (UX_write (fd, buf, 1)));
- }
- }
- transaction_commit ();
- return (SHARP_F);
-}
-
-static void
-DEFUN (protect_fd_close, (ap), PTR ap)
-{
- UX_close (* ((int *) ap));
-}
-
-static void
-DEFUN (protect_fd, (fd), int fd)
-{
- int * p = (dstack_alloc (sizeof (int)));
- (*p) = fd;
- transaction_record_action (tat_always, protect_fd_close, p);
+ (chars[0]) = (((bits & S_IRUSR) != 0) ? 'r' : '-');
+ (chars[1]) = (((bits & S_IWUSR) != 0) ? 'w' : '-');
+ (chars[2]) = (((bits & S_IXUSR) != 0) ? 'x' : '-');
}
\f
DEFINE_PRIMITIVE ("FILE-EQ?", Prim_file_eq_p, 2, 2,
/* -*-C-*-
-$Id: pruxio.c,v 1.7 1999/01/02 06:11:34 cph Exp $
+$Id: pruxio.c,v 1.8 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
unsigned int lub = (UX_select_registry_lub ());
unsigned int * fds = (dstack_alloc ((sizeof (unsigned int)) * lub));
unsigned int nfds;
- SCHEME_OBJECT result;
+ SCHEME_OBJECT result = SHARP_F;
if ((VECTOR_LENGTH (ARG_REF (3))) != lub)
error_bad_range_arg (3);
enum process_ctty_type ctty_type;
char * ctty_name = 0;
enum process_channel_type channel_in_type;
- Tchannel channel_in;
+ Tchannel channel_in = NO_CHANNEL;
enum process_channel_type channel_out_type;
- Tchannel channel_out;
+ Tchannel channel_out = NO_CHANNEL;
enum process_channel_type channel_err_type;
- Tchannel channel_err;
+ Tchannel channel_err = NO_CHANNEL;
if ((ARG_REF (5)) == SHARP_F)
ctty_type = process_ctty_type_none;
/* -*-C-*-
-$Id: pruxsock.c,v 1.17 1999/08/13 18:29:06 cph Exp $
+$Id: pruxsock.c,v 1.18 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "scheme.h"
#include "prims.h"
-#ifdef _UNIX
/* This obtains the HAVE_SOCKETS definition. */
-#include "ux.h"
+#ifdef __unix__
+# include "ux.h"
#endif
-#ifdef __OS2__
/* Under OS/2, socket support is the default but can be disabled. */
-#ifndef DISABLE_SOCKET_SUPPORT
-#define HAVE_SOCKETS 1
-#define HAVE_UNIX_SOCKETS 1
-#endif
+#ifdef __OS2__
+# ifndef DISABLE_SOCKET_SUPPORT
+# define HAVE_SOCKETS 1
+# define HAVE_UNIX_SOCKETS 1
+# endif
#endif
-#ifdef __NT__
-/* Under NT, socket support is the default but can be disabled. */
-#ifndef DISABLE_SOCKET_SUPPORT
-#define HAVE_SOCKETS 1
-#undef HAVE_UNIX_SOCKETS
-#endif
+/* Under Win32, socket support is the default but can be disabled. */
+#ifdef __WIN32__
+# ifndef DISABLE_SOCKET_SUPPORT
+# define HAVE_SOCKETS 1
+# undef HAVE_UNIX_SOCKETS
+# endif
#endif
#ifdef HAVE_SOCKETS
/* -*-C-*-
-$Id: psbmap.h,v 9.43 1999/01/02 06:06:43 cph Exp $
+$Id: psbmap.h,v 9.44 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
from the included files.
*/
-#define WINNT_RAW_ADDRESSES
#define fast register
+#include "config.h"
#include <stdio.h>
-#ifndef _NEXTOS
-#include <stdlib.h>
+#ifdef STDC_HEADERS
+# include <stdlib.h>
#endif
-#include "oscond.h"
-#include "ansidecl.h"
-#include "config.h"
#include "types.h"
#include "object.h"
#include "bignum.h"
/* -*-C-*-
-$Id: purify.c,v 9.58 1999/01/02 06:11:34 cph Exp $
+$Id: purify.c,v 9.59 2000/12/05 21:23:48 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
break;
default:
- GC_BAD_TYPE ("purifyloop");
+ GC_BAD_TYPE ("purifyloop", Temp);
/* Fall Through */
case_Non_Pointer:
/* -*-C-*-
-$Id: purutl.c,v 9.50 2000/01/18 05:09:17 cph Exp $
+$Id: purutl.c,v 9.51 2000/12/05 21:23:48 cph Exp $
Copyright (c) 1987-2000 Massachusetts Institute of Technology
#include "prims.h"
#include "gccode.h"
#include "zones.h"
+#include "cmpint.h"
-#ifdef __STDC__
-#include <stdlib.h>
+#ifdef STDC_HEADERS
+# include <stdlib.h>
#endif
\f
static void
PRIMITIVE_RETURN (SHARP_T);
TOUCH_IN_PRIMITIVE (object, object);
{
- extern SCHEME_OBJECT * compiled_entry_to_block_address ();
SCHEME_OBJECT * address =
((GC_Type_Compiled (object))
? (compiled_entry_to_block_address (object))
/* -*-C-*-
-$Id: regex.c,v 1.19 1999/01/02 06:11:34 cph Exp $
+$Id: regex.c,v 1.20 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "syntax.h"
#include "regex.h"
-extern char * malloc ();
-extern char * realloc ();
-extern void free ();
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+#else
+ extern char * malloc ();
+ extern char * realloc ();
+ extern void free ();
+#endif
\f
-#if defined(_IRIX) || defined(_AIX)
+#if defined(__IRIX__) || defined(_AIX)
#define SIGN_EXTEND_CHAR(x) ((((int) (x)) >= 0x80) \
? (((int) (x)) - 0x100) \
: ((int) (x)))
} while (0)
static Boolean
-beq_translate (scan1, scan2, length, translation)
- fast unsigned char *scan1, *scan2;
- fast long length;
- fast unsigned char *translation;
+DEFUN (beq_translate, (scan1, scan2, length, translation),
+ unsigned char * scan1 AND
+ unsigned char * scan2 AND
+ long length AND
+ unsigned char * translation)
{
while ((length--) > 0)
if ((TRANSLATE_CHAR (*scan1++)) != (TRANSLATE_CHAR (*scan2++)))
/* -*-C-*-
-$Id: scheme.h,v 9.38 1999/01/02 06:11:34 cph Exp $
+$Id: scheme.h,v 9.39 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#define forward extern /* For forward references */
+#include "config.h"
+
#include <stdio.h>
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+#endif
-#include "oscond.h" /* Identify the operating system */
-#include "ansidecl.h" /* Macros to support ANSI declarations */
#include "dstack.h" /* Dynamic stack support package */
#include "obstack.h" /* Obstack package */
-#include "config.h" /* Machine and OS configuration info */
#include "types.h" /* Type code numbers */
#include "const.h" /* Various named constants */
#include "object.h" /* Scheme object representation */
/* -*-C-*-
-$Id: storage.c,v 9.56 1999/01/02 06:11:34 cph Exp $
+$Id: storage.c,v 9.57 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
/*************/
SCHEME_OBJECT
-#ifndef DOS386
- * MemTop, /* Top of free space available */
-#endif /* DOS386 */
+ * MemTop, /* Top of free space available */
* Free, /* Next free word in heap */
* Heap_Top, /* Top of current heap */
* Heap_Bottom, /* Bottom of current heap */
/* -*-C-*-
-$Id: syntax.c,v 1.24 1999/01/02 06:11:34 cph Exp $
+$Id: syntax.c,v 1.25 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
{
case syntaxcode_comment: MERGE_COMMENT (COMSTART_FIRST_B); break;
case syntaxcode_endcomment: MERGE_COMMENT (COMEND_FIRST_B); break;
+ default: break;
}
break;
case 'p': MERGE_PREFIX_BIT (1 << 20); break;
fast SCHEME_OBJECT group; \
fast unsigned char * start; \
unsigned char * first_char, * end; \
- long sentry; \
long gap_length; \
PRIMITIVE_HEADER (arity); \
CHECK_ARG (1, SYNTAX_TABLE_P); \
#define NORMAL_INITIALIZATION_BACKWARD(arity) \
fast unsigned char * gap_start; \
unsigned char * gap_end; \
- Boolean quoted; \
NORMAL_INITIALIZATION_COMMON (arity); \
if (start > gap_start) \
start += gap_length; \
#define RIGHT_QUOTED_P_INTERNAL(scan, quoted) do \
{ \
- long sentry; \
- \
quoted = false; \
while (true) \
{ \
+ long sentry; \
if (LEFT_END_P (scan)) \
break; \
READ_LEFT (scan, sentry); \
DEFINE_PRIMITIVE ("QUOTED-CHAR?", Prim_quoted_char_p, 4, 4, 0)
{
+ Boolean quoted;
NORMAL_INITIALIZATION_BACKWARD (4);
RIGHT_QUOTED_P (start, quoted);
DEFINE_PRIMITIVE ("SCAN-BACKWARD-PREFIX-CHARS", Prim_scan_backward_prefix_chars, 4, 4, 0)
{
+ Boolean quoted;
NORMAL_INITIALIZATION_BACKWARD (4);
while (true)
while (true)
{
+ long sentry;
LOSE_IF_RIGHT_END (start);
READ_RIGHT (start, sentry);
if ((SYNTAX_ENTRY_CODE (sentry)) == syntaxcode_word)
while (true)
{
+ long sentry;
LOSE_IF_LEFT_END (start);
READ_LEFT (start, sentry);
if ((SYNTAX_ENTRY_CODE (sentry)) == syntaxcode_word)
while (true)
{
+ long sentry;
LOSE_IF_RIGHT_END (start);
c = (*start);
READ_RIGHT (start, sentry);
MOVE_RIGHT (start);
WIN_IF ((depth == 0) && sexp_flag);
break;
+
+ default:
+ break;
}
}
}
\f
DEFINE_PRIMITIVE ("SCAN-LIST-BACKWARD", Prim_scan_list_backward, 7, 7, 0)
{
+ Boolean quoted;
SCAN_LIST_INITIALIZATION (NORMAL_INITIALIZATION_BACKWARD);
while (true)
{
+ long sentry;
LOSE_IF_LEFT_END (start);
LEFT_QUOTED_P (start, quoted);
if (quoted)
MOVE_LEFT (start);
WIN_IF ((depth == 0) && sexp_flag);
break;
+
+ default:
+ break;
}
}
}
long target_depth;
Boolean stop_before;
SCHEME_OBJECT state_argument;
- long depth;
- long in_string; /* -1 or delimiter character */
+ long depth = 0;
+ long in_string = -1; /* -1 or delimiter character */
/* Values of in_comment:
0 = not in comment
1 = in comment
2 = found first start of comment
3 = found first end of comment */
- unsigned int in_comment;
- unsigned int comment_style;
- unsigned char * comment_start;
- Boolean quoted;
+ unsigned int in_comment = 0;
+ unsigned int comment_style = COMMENT_STYLE_A;
+ unsigned char * comment_start = 0;
+ Boolean quoted = false;
struct levelstruct level_start[LEVEL_ARRAY_LENGTH];
struct levelstruct *level;
struct levelstruct *level_end;
- int c;
+ int c = 0;
+ long sentry = 0;
SCHEME_OBJECT result;
NORMAL_INITIALIZATION_FORWARD (7);
(level -> previous) = (level -> last);
MOVE_RIGHT (start);
break;
+
+ default:
+ break;
}
}
/* NOTREACHED */
/* -*-C-*-
-$Id: syscall.h,v 1.12 1999/04/07 04:01:47 cph Exp $
+$Id: syscall.h,v 1.13 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#ifndef SCM_SYSCALL_H
#define SCM_SYSCALL_H
-#include "oscond.h"
+#include "config.h"
\f
-#ifdef _OS2
+#ifdef __OS2__
#define DEFINE_OS2_SYSCALLS
#include "os2api.h"
#undef DEFINE_OS2_SYSCALLS
-#else /* not _OS2 */
-#ifdef WINNT
+#else /* not __OS2__ */
+#ifdef __WIN32__
#define DEFINE_WIN32_SYSCALLS
#include "ntapi.h"
#undef DEFINE_WIN32_SYSCALLS
-#else /* not WINNT */
+#else /* not __WIN32__ */
enum syscall_names
{
syserr_too_many_open_files_in_system
};
-#endif /* not WINNT */
-#endif /* not _OS2 */
+#endif /* not __WIN32__ */
+#endif /* not __OS2__ */
extern void EXFUN (error_in_system_call,
(enum syserr_names, enum syscall_names));
/* -*-C-*-
-$Id: sysprim.c,v 9.46 1999/01/02 06:11:34 cph Exp $
+$Id: sysprim.c,v 9.47 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "prims.h"
#include "ostty.h"
#include "ostop.h"
+
+extern long EXFUN (OS_set_trap_state, (long));
\f
/* Pretty random primitives */
DEFINE_PRIMITIVE ("SET-TRAP-STATE!", Prim_set_trap_state, 1, 1, 0)
{
long result;
- extern long OS_set_trap_state();
PRIMITIVE_HEADER (1);
result = (OS_set_trap_state (arg_nonnegative_integer (1)));
/* -*-C-*-
-$Id: term.c,v 1.14 1999/01/02 06:11:34 cph Exp $
+$Id: term.c,v 1.15 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
extern void EXFUN (get_band_parameters, (long * heap_size, long * const_size));
extern void EXFUN (Reset_Memory, (void));
-#if defined(WINNT) || defined(_OS2)
-#define USING_MESSAGE_BOX_FOR_FATAL_OUTPUT
-extern void winnt_deallocate_registers (void);
+#ifdef __WIN32__
+# define USING_MESSAGE_BOX_FOR_FATAL_OUTPUT
+ extern void win32_deallocate_registers (void);
+#endif
+
+#ifdef __OS2__
+# define USING_MESSAGE_BOX_FOR_FATAL_OUTPUT
#endif
static void EXFUN (edwin_auto_save, (void));
#define MIN_HEAP_DELTA 50
#ifndef EXIT_SCHEME
-#define EXIT_SCHEME exit
+# define EXIT_SCHEME exit
#endif
#ifdef EXIT_SCHEME_DECLARATIONS
if (code != TERM_HALT)
#endif
outf_flush_fatal();
-#ifdef WINNT
- winnt_deallocate_registers();
+#ifdef __WIN32__
+ win32_deallocate_registers();
#endif
Reset_Memory ();
EXIT_SCHEME (value);
#endif
#ifdef MIT_SCHEME
-# include "oscond.h"
-# ifdef _UNIX
+# include "config.h"
+# ifdef __unix__
# include "ux.h"
# endif
#endif
# define PTR void *
# else
# define PTR char *
-# endif /* __STDC__ */
-#endif /* PTR */
+# endif
+#endif
#ifndef NULL
-#define NULL 0
+# define NULL 0
#endif
static
short ospeed;
-#ifdef NO_BAUD_CONVERSION
-
-/* This is a kludge. */
-
static
short convert_ospeed (os)
unsigned short os;
{
- if (os >= 300)
- return (0 - ((short) (os / 100)));
+ unsigned int rate = (OS_baud_index_to_rate (os));
+ if (rate >= 300)
+ return (0 - ((short) (rate / 100)));
else
- return ((short) (os));
+ return ((short) (rate));
}
-#define OSPEED() convert_ospeed ((unsigned short) ospeed)
-
-#else
-
-/* Actual baud rate if positive;
- - baud rate / 100 if negative. */
-
-static short speeds[] =
- {
-#ifdef VMS
- 0, 50, 75, 110, 134, 150, -3, -6, -12, -18,
- -20, -24, -36, -48, -72, -96, -192
-#else /* not VMS */
- 0, 50, 75, 110, 135, 150, -2, -3, -6, -12,
- -18, -24, -48, -96, -192, -384
-#endif /* not VMS */
- };
-
-#define OSPEED() speeds[ospeed]
-#endif
+#define OSPEED() (convert_ospeed ((unsigned short) ospeed))
\f
/* Looking up capabilities in the entry already found */
/* Interface from Emacs to terminfo.
Copyright (C) 1985, 1986 Free Software Foundation, Inc.
- Copyright (C) 1998 Massachusetts Institute of Technology
+ Copyright (C) 1998, 2000 Massachusetts Institute of Technology
-$Id: terminfo.c,v 1.3 2000/01/18 05:09:25 cph Exp $
+$Id: terminfo.c,v 1.4 2000/12/05 21:23:48 cph Exp $
This file is part of GNU Emacs.
so that we do not need to conditionalize the places in Emacs
that set them. */
-#include "oscond.h"
+#include "config.h"
-#ifdef __STDC__
-#include <stdlib.h>
+#ifdef STDC_HEADERS
+# include <stdlib.h>
#endif
-#ifndef _IRIX
+#ifndef __IRIX__
char *UP, *BC, PC;
short ospeed;
#endif
/* -*-C-*-
-$Id: transact.c,v 1.4 2000/01/18 05:09:40 cph Exp $
+$Id: transact.c,v 1.5 2000/12/05 21:23:48 cph Exp $
Copyright (C) 1990-2000 Massachusetts Institute of Technology
*/
#include <stdio.h>
-#include "ansidecl.h"
+#include "config.h"
#include "outf.h"
#include "dstack.h"
/* -*-C-*-
-Copyright (c) 1987, 1988, 1989, 1999 Massachusetts Institute of Technology
+$Id: trap.h,v 9.45 2000/12/05 21:23:48 cph Exp $
+
+Copyright (c) 1987, 1988, 1989, 1999, 2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
-
-/* $Id: trap.h,v 9.44 1999/01/02 06:06:43 cph Exp $ */
\f
/* Kinds of traps:
\f
/* Common constants */
-#ifdef b32 /* 32 bit objects */
-
-#if (TYPE_CODE_LENGTH == 8)
-#define UNASSIGNED_OBJECT 0x32000000
-#define DANGEROUS_UNASSIGNED_OBJECT 0x32000001
-#define UNBOUND_OBJECT 0x32000002
-#define DANGEROUS_UNBOUND_OBJECT 0x32000003
-#define ILLEGAL_OBJECT 0x32000004
-#define DANGEROUS_ILLEGAL_OBJECT 0x32000005
-#define EXPENSIVE_OBJECT 0x32000006
-#define DANGEROUS_EXPENSIVE_OBJECT 0x32000007
-#endif /* (TYPE_CODE_LENGTH == 8) */
-
-#if (TYPE_CODE_LENGTH == 6)
-#define UNASSIGNED_OBJECT 0xc8000000
-#define DANGEROUS_UNASSIGNED_OBJECT 0xc8000001
-#define UNBOUND_OBJECT 0xc8000002
-#define DANGEROUS_UNBOUND_OBJECT 0xc8000003
-#define ILLEGAL_OBJECT 0xc8000004
-#define DANGEROUS_ILLEGAL_OBJECT 0xc8000005
-#define EXPENSIVE_OBJECT 0xc8000006
-#define DANGEROUS_EXPENSIVE_OBJECT 0xc8000007
-#endif /* (TYPE_CODE_LENGTH == 6) */
-
-#if (TC_REFERENCE_TRAP != 0x32)
-#include "error: trap.h and types.h are inconsistent"
+#if (SIZEOF_UNSIGNED_LONG == 4) /* 32 bit objects */
+# if (TYPE_CODE_LENGTH == 8)
+# define UNASSIGNED_OBJECT 0x32000000
+# define DANGEROUS_UNASSIGNED_OBJECT 0x32000001
+# define UNBOUND_OBJECT 0x32000002
+# define DANGEROUS_UNBOUND_OBJECT 0x32000003
+# define ILLEGAL_OBJECT 0x32000004
+# define DANGEROUS_ILLEGAL_OBJECT 0x32000005
+# define EXPENSIVE_OBJECT 0x32000006
+# define DANGEROUS_EXPENSIVE_OBJECT 0x32000007
+# endif
+# if (TYPE_CODE_LENGTH == 6)
+# define UNASSIGNED_OBJECT 0xc8000000
+# define DANGEROUS_UNASSIGNED_OBJECT 0xc8000001
+# define UNBOUND_OBJECT 0xc8000002
+# define DANGEROUS_UNBOUND_OBJECT 0xc8000003
+# define ILLEGAL_OBJECT 0xc8000004
+# define DANGEROUS_ILLEGAL_OBJECT 0xc8000005
+# define EXPENSIVE_OBJECT 0xc8000006
+# define DANGEROUS_EXPENSIVE_OBJECT 0xc8000007
+# endif
+# if (TC_REFERENCE_TRAP != 0x32)
+# include "error: trap.h and types.h are inconsistent"
+# endif
#endif
-#endif /* b32 */
-
#ifndef UNASSIGNED_OBJECT /* Safe version */
-#define UNASSIGNED_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
-#define DANGEROUS_UNASSIGNED_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
-#define UNBOUND_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNBOUND)
-#define DANGEROUS_UNBOUND_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
-#define ILLEGAL_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_ILLEGAL)
-#define DANGEROUS_ILLEGAL_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
-#define EXPENSIVE_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
-#define DANGEROUS_EXPENSIVE_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
-#endif /* UNASSIGNED_OBJECT */
+# define UNASSIGNED_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
+# define DANGEROUS_UNASSIGNED_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
+# define UNBOUND_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNBOUND)
+# define DANGEROUS_UNBOUND_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
+# define ILLEGAL_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_ILLEGAL)
+# define DANGEROUS_ILLEGAL_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
+# define EXPENSIVE_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
+# define DANGEROUS_EXPENSIVE_OBJECT MAKE_OBJECT (TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
+#endif
#define NOP_OBJECT (LONG_TO_UNSIGNED_FIXNUM (TRAP_NOP))
#define DANGEROUS_OBJECT (LONG_TO_UNSIGNED_FIXNUM (TRAP_DANGEROUS))
/* -*-C-*-
-$Id: utils.c,v 9.74 1999/01/02 06:11:34 cph Exp $
+$Id: utils.c,v 9.75 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#include "history.h"
#include "cmpint.h"
#include "syscall.h"
+
+#ifdef __OS2__
+extern void OS2_handle_attention_interrupt (void);
+#endif
\f
/* Helper procedures for Setup_Interrupt, which follows. */
long interrupt_mask;
SCHEME_OBJECT interrupt_handler;
-#ifdef _OS2
+#ifdef __OS2__
if ((1 << interrupt_number) == INT_Global_1)
{
- extern void OS2_handle_attention_interrupt ();
OS2_handle_attention_interrupt ();
abort_to_interpreter (PRIM_POP_RETURN);
}
-#endif /* _OS2 */
+#endif /* __OS2__ */
if (! (Valid_Fixed_Obj_Vector ()))
{
outf_fatal ("\nInvalid fixed-objects vector.");
Note: This is called only from the macro PRIMITIVE_CANONICALIZE_CONTEXT,
so that the work can be divided between them if it is an issue. */
-extern void EXFUN (canonicalize_primitive_context, (void));
-
void
DEFUN_VOID (canonicalize_primitive_context)
{
Boolean
DEFUN (interpreter_applicable_p, (object), fast SCHEME_OBJECT object)
{
- extern void compiled_entry_type ();
tail_recurse:
switch (OBJECT_TYPE (object))
{
DEFUN (Do_Micro_Error, (Err, From_Pop_Return),
long Err AND Boolean From_Pop_Return)
{
- SCHEME_OBJECT Error_Vector, Handler;
+ SCHEME_OBJECT Error_Vector = SHARP_F;
+ SCHEME_OBJECT Handler;
if (Consistency_Check)
{
/*NOTREACHED*/
}
\f
-#ifndef _OS2
-
-extern SCHEME_OBJECT EXFUN (Compiler_Get_Fixed_Objects, (void));
+#ifndef __OS2__
SCHEME_OBJECT
DEFUN_VOID (Compiler_Get_Fixed_Objects)
}
extern SCHEME_OBJECT EXFUN (Re_Enter_Interpreter, (void));
-extern SCHEME_OBJECT EXFUN (C_call_scheme,
- (SCHEME_OBJECT, long, SCHEME_OBJECT *));
+extern SCHEME_OBJECT EXFUN
+ (C_call_scheme, (SCHEME_OBJECT, long, SCHEME_OBJECT *));
-#ifdef WINNT
-#include <windows.h>
+#ifdef __WIN32__
+# include <windows.h>
#endif
SCHEME_OBJECT
SCHEME_OBJECT primitive, prim_lexpr, * sp, result;
SCHEME_OBJECT * callers_last_return_code;
-#ifdef i386
- extern void * C_Frame_Pointer, * C_Stack_Pointer;
- void * cfp, * csp;
-
- cfp = C_Frame_Pointer;
- csp = C_Stack_Pointer;
-#ifdef NT386CL
+#ifdef __IA32__
+ extern void * C_Frame_Pointer;
+ extern void * C_Stack_Pointer;
+ void * cfp = C_Frame_Pointer;
+ void * csp = C_Stack_Pointer;
+#ifdef CL386
__try
-#endif /* NT386CL */
-#endif /* i386 */
+#endif
+#endif
{
primitive = (Regs [REGBLOCK_PRIMITIVE]);
prim_lexpr = (Regs [REGBLOCK_LEXPR_ACTUALS]);
Regs [REGBLOCK_LEXPR_ACTUALS] = prim_lexpr;
Regs [REGBLOCK_PRIMITIVE] = primitive;
}
-#ifdef i386
-#ifdef NT386CL
+#ifdef __IA32__
+#ifdef CL386
__finally
-#endif /* NT386CL */
+#endif
{
C_Frame_Pointer = cfp;
C_Stack_Pointer = csp;
}
-#endif /* i386 */
+#endif
return result;
}
-#endif /* not _OS2 */
+#endif /* not __OS2__ */
/* -*-C-*-
-$Id: ux.c,v 1.19 2000/01/31 03:42:03 cph Exp $
+$Id: ux.c,v 1.20 2000/12/05 21:23:48 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
deliver_pending_interrupts ();
}
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
int
DEFUN (UX_terminal_get_state, (fd, s), int fd AND Ttty_state * s)
{
return
((((tcgetattr (fd, (& (s -> tio)))) < 0)
-#ifdef _HPUX
+#ifdef __HPUX__
|| ((UX_ioctl (fd, TIOCGLTC, (& (s -> ltc)))) < 0)
#endif
) ? (-1) : 0);
{
return
((((tcsetattr (fd, TCSANOW, (& (s -> tio)))) < 0)
-#ifdef _HPUX
+#ifdef __HPUX__
|| ((UX_ioctl (fd, TIOCSLTC, (& (s -> ltc)))) < 0)
#endif
) ? (-1) : 0);
}
-#else /* not HAVE_TERMIOS */
-#ifdef HAVE_TERMIO
+#else /* not HAVE_TERMIOS_H */
+#ifdef HAVE_TERMIO_H
int
DEFUN (UX_terminal_get_state, (fd, s), int fd AND Ttty_state * s)
{
return
((((UX_ioctl (fd, TCGETA, (& (s -> tio)))) < 0)
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
|| ((UX_ioctl (fd, TIOCGLTC, (& (s -> ltc)))) < 0)
#endif
) ? (-1) : 0);
{
return
((((UX_ioctl (fd, TCSETA, (& (s -> tio)))) < 0)
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
|| ((UX_ioctl (fd, TIOCSLTC, (& (s -> ltc)))) < 0)
#endif
) ? (-1) : 0);
return (UX_ioctl (fd, TCFLSH, queue_selector));
}
-#else /* not HAVE_TERMIO */
+#else /* not HAVE_TERMIO_H */
\f
-#ifdef HAVE_BSD_TTY_DRIVER
+#ifdef HAVE_SGTTY_H
int
DEFUN (UX_terminal_get_state, (fd, s), int fd AND Ttty_state * s)
return
((((UX_ioctl (fd, TIOCGETP, (& (s -> sg)))) < 0)
|| ((UX_ioctl (fd, TIOCGETC, (& (s -> tc)))) < 0)
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
|| ((UX_ioctl (fd, TIOCGLTC, (& (s -> ltc)))) < 0)
#endif
|| ((UX_ioctl (fd, TIOCLGET, (& (s -> lmode)))) < 0))
return
((((UX_ioctl (fd, TIOCSETN, (& (s -> sg)))) < 0)
|| ((UX_ioctl (fd, TIOCSETC, (& (s -> tc)))) < 0)
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
|| ((UX_ioctl (fd, TIOCSLTC, (& (s -> ltc)))) < 0)
#endif
|| ((UX_ioctl (fd, TIOCLSET, (& (s -> lmode)))) < 0))
return (UX_ioctl (fd, TIOCFLUSH, (&zero)));
}
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIO */
-#endif /* HAVE_TERMIOS */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIO_H */
+#endif /* HAVE_TERMIOS_H */
\f
-#if !defined(_POSIX) && defined(_BSD)
-
+#ifdef SLAVE_PTY_P
+int
+DEFUN (UX_setup_slave_pty, (fd), int fd)
+{
+ return
+ (((ioctl (fd, I_PUSH, "ptem")) == 0)
+ && ((ioctl (fd, I_PUSH, "ldterm")) == 0)
+#if !defined(sgi) && !defined(__sgi)
+ && (((ioctl (fd, I_FIND, "ttcompat")) != 0)
+ || ((ioctl (fd, I_PUSH, "ttcompat")) == 0))
+#endif
+ );
+}
+#endif
+\f
+#ifdef EMULATE_GETPGRP
pid_t
DEFUN_VOID (UX_getpgrp)
{
return (getpgrp (getpid ()));
}
+#endif
+#ifdef EMULATE_SETSID
pid_t
DEFUN_VOID (UX_setsid)
{
#ifdef TIOCNOTTY
- int fd = (UX_open (BSD_DEV_TTY, O_RDWR, 0));
+ int fd = (UX_open ("/dev/tty", O_RDWR, 0));
if (fd >= 0)
{
UX_ioctl (fd, TIOCNOTTY, 0);
#endif
return (setpgrp (0, 0));
}
+#endif
-#ifndef _SUNOS
+#ifdef EMULATE_SETPGID
+int
+DEFUN (UX_setpgid, (pid, pgid), pid_t pid AND pid_t pgid)
+{
+ errno = ENOSYS;
+ return (-1);
+}
+#endif
+#ifdef EMULATE_CTERMID
char *
DEFUN (UX_ctermid, (s), char * s)
{
- static char result [] = BSD_DEV_TTY;
+ static char result [] = "/dev/tty";
if (s == 0)
return (result);
- strcpy (s, BSD_DEV_TTY);
+ strcpy (s, result);
return (s);
}
+#endif
+#ifdef EMULATE_KILL
int
DEFUN (UX_kill, (pid, sig), pid_t pid AND int sig)
{
return ((pid >= 0) ? (kill (pid, sig)) : (killpg ((-pid), sig)));
}
+#endif
-#endif /* not _SUNOS */
-#endif /* not _POSIX and _BSD */
-
-#ifndef _POSIX
-#ifdef HAVE_BSD_JOB_CONTROL
-
+#ifdef EMULATE_TCGETPGRP
pid_t
DEFUN (UX_tcgetpgrp, (fd), int fd)
{
+#ifdef TIOCGPGRP
pid_t pgrp_id;
return (((UX_ioctl (fd, TIOCGPGRP, (&pgrp_id))) < 0) ? (-1) : pgrp_id);
-}
-
-int
-DEFUN (UX_tcsetpgrp, (fd, pgrp_id),
- int fd AND
- pid_t pgrp_id)
-{
- return (UX_ioctl (fd, TIOCSPGRP, (&pgrp_id)));
-}
-
-#else /* not HAVE_BSD_JOB_CONTROL */
-
-pid_t
-DEFUN (UX_tcgetpgrp, (fd), int fd)
-{
+#else
errno = ENOSYS;
return (-1);
+#endif
}
+#endif
+#ifdef EMULATE_TCSETPGRP
int
DEFUN (UX_tcsetpgrp, (fd, pgrp_id),
int fd AND
pid_t pgrp_id)
{
+#ifdef TIOCSPGRP
+ return (UX_ioctl (fd, TIOCSPGRP, (&pgrp_id)));
+#else
errno = ENOSYS;
return (-1);
+#endif
}
-
-#endif /* HAVE_BSD_JOB_CONTROL */
-#endif /* not _POSIX */
+#endif
\f
#ifdef EMULATE_GETCWD
char *
}
}
}
-#endif /* HAVE_GETWD */
+#endif /* not HAVE_GETWD */
if (collection_buffer == internal_buffer)
{
if (length <= (strlen (internal_buffer)))
}
return (buffer);
}
-#endif /* not EMULATE_GETCWD */
+#endif /* EMULATE_GETCWD */
\f
#ifdef EMULATE_WAITPID
int
DEFUN (UX_waitpid, (pid, stat_loc, options),
pid_t pid AND
- wait_status_t * stat_loc AND
+ int * stat_loc AND
int options)
{
if (pid == (-1))
errno = EINVAL;
return (-1);
}
-#endif /* EMULATE_WAITPID */
+#endif
#ifdef EMULATE_DUP2
int
return (result);
}
}
-#endif /* EMULATE_DUP2 */
+#endif
#ifdef EMULATE_RENAME
int
? result
: (UX_unlink (from_name)));
}
-#endif /* EMULATE_RENAME */
+#endif
#ifdef EMULATE_MKDIR
int
{
return (UX_mknod (name, ((mode & MODE_DIR) | S_IFDIR), ((dev_t) 0)));
}
-#endif /* EMULATE_MKDIR */
+#endif
\f
-#ifdef _POSIX
+#ifdef _POSIX_VERSION
cc_t
DEFUN (UX_PC_VDISABLE, (fildes), int fildes)
{
- extern long EXFUN (fpathconf, (int, int));
- long result = (fpathconf (fildes, _PC_VDISABLE));
- return
- ((cc_t) ((result < 0) ?
#ifdef _POSIX_VDISABLE
- _POSIX_VDISABLE
+ return ((cc_t) _POSIX_VDISABLE);
#else
- '\377'
+ long result = (fpathconf (fildes, _PC_VDISABLE));
+ return ((cc_t) ((result < 0) ? '\377' : result));
#endif
- : result));
}
static clock_t memoized_clk_tck = 0;
return (memoized_clk_tck);
}
-#endif /* _POSIX */
+#endif /* _POSIX_VERSION */
\f
-#ifndef HAVE_SIGSET_OPS
+#ifndef HAVE_SIGACTION
int
DEFUN (UX_sigemptyset, (set), sigset_t * set)
}
}
\f
-#ifdef HAVE_BSD_SIGNALS
-
-#ifdef _HPUX
-#define UX_sigvec sigvector
-#else
-#define UX_sigvec sigvec
-#endif
+#ifdef HAVE_SIGVEC
#ifndef SV_INTERRUPT
-#define SV_INTERRUPT 0
+# define SV_INTERRUPT 0
#endif
int
return (sigpause (*set));
}
-#endif /* HAVE_BSD_SIGNALS */
-#endif /* not _POSIX */
+#endif /* HAVE_SIGVEC */
+#endif /* not _POSIX_VERSION */
\f
#ifdef EMULATE_SYSCONF
-
long
DEFUN (sysconf, (parameter), int parameter)
{
#endif /* CHILD_MAX */
case _SC_JOB_CONTROL:
-#if defined(_POSIX_JOB_CONTROL) || defined(HAVE_BSD_JOB_CONTROL)
+#ifdef TIOCGPGRP
return ((long) 1);
#else
return ((long) 0);
return ((long) (-1));
}
}
-
#endif /* EMULATE_SYSCONF */
#ifdef EMULATE_FPATHCONF
-
long
DEFUN (fpathconf, (filedes, parameter), int filedes AND int parameter)
{
return ((long) (-1));
}
}
-
#endif /* EMULATE_FPATHCONF */
\f
void *
UX_free (ptr);
}
-#ifdef __linux
+#ifdef __linux__
#include <sys/mman.h>
return ((addr == ((void *) (-1))) ? 0 : addr);
}
-#endif /* __linux */
+#endif /* __linux__ */
#ifdef __FreeBSD__
/* -*-C-*-
-$Id: ux.h,v 1.73 2000/01/18 05:09:49 cph Exp $
+$Id: ux.h,v 1.74 2000/12/05 21:23:48 cph Exp $
Copyright (c) 1988-2000 Massachusetts Institute of Technology
#ifndef SCM_UX_H
#define SCM_UX_H
-
+\f
#define SYSTEM_NAME "unix"
-#include "oscond.h"
-#include "ansidecl.h"
-#include "posixtyp.h"
-
-#ifndef _POSIX /* Prevent multiple inclusion */
-# include <sys/times.h>
-#endif /* _POSIX */
-#include <sys/file.h>
-#include <sys/param.h>
-#include <sys/stat.h>
-#include <stdio.h>
-#include <signal.h>
-#include <errno.h>
-#include <pwd.h>
-#include <grp.h>
-
-#ifdef __STDC__
-#include <stdlib.h>
-#include <string.h>
+#ifdef __386BSD__
+# define SYSTEM_VARIANT "386BSD"
#endif
-extern int errno;
-
-/* These seem to be missing from versions of unistd.h */
-
-#if !(defined(_HPUX) || defined(sonyrisc) || defined(_SUNOS4) || defined(_IRIX6))
-/* As specified by OSF/1 Programmer's reference: */
-extern int EXFUN (ioctl, (int, unsigned long, ...));
-#endif
-#if !(defined(_SUNOS4) || defined(_AIX))
-extern int EXFUN (open, (const char *, int, ...));
+#ifdef _AIX
+# define SYSTEM_VARIANT "AIX"
#endif
-extern int EXFUN (kill, (pid_t, int));
-
-#include "intext.h"
-#include "dstack.h"
-#include "osscheme.h"
-#include "syscall.h"
-\f
-/* Conditionalizations that are overridden by _POSIX. */
-
-#ifdef _POSIX
-#ifdef __osf__
-# include <sys/time.h>
-# include <sys/ioctl.h>
-# define NO_BAUD_CONVERSION
-# define SYSTEM_VARIANT "OSF"
+#ifdef apollo
+# define SYSTEM_VARIANT "Domain"
#endif
-#ifdef __386BSD__
-# include <sys/ioctl.h>
-# define EMULATE_FPATHCONF
-# define EMULATE_SYSCONF
-# define NO_BAUD_CONVERSION
-# define SYSTEM_VARIANT "386BSD"
+#ifdef __bsdi__ /* works on bsdi 3.0 */
+# define SYSTEM_VARIANT "BSDI BSD/OS"
#endif
#ifdef __FreeBSD__
-# include <sys/ioctl.h>
-# define EMULATE_FPATHCONF
-# define EMULATE_SYSCONF
-# define NO_BAUD_CONVERSION
# define SYSTEM_VARIANT "FreeBSD"
#endif
-#ifdef __bsdi__ /* works on bsdi 3.0 */
-# define SELECT_DECLARED
-# include <sys/ioctl.h>
-# define EMULATE_FPATHCONF
-# define EMULATE_SYSCONF
-# define NO_BAUD_CONVERSION
-# define SYSTEM_VARIANT "BSDI BSD/OS"
+#if defined(__hpux) || defined(hpux)
+# define SYSTEM_VARIANT "HP/UX"
#endif
-#ifdef _IRIX6
-#define NO_BAUD_CONVERSION
+#if defined(_IRIX) || defined(_IRIX4) || defined(_IRIX6)
+# define SYSTEM_VARIANT "Irix"
#endif
-/* no longer needed */
-#if 0
-#ifdef sonyrisc
-/* <limits.h> will redefine these. */
-#undef DBL_MAX
-#undef DBL_MIN
-#undef FLT_MAX
-#undef FLT_MIN
-#endif
+#ifdef __linux__
+# define SYSTEM_VARIANT "GNU/Linux"
#endif
-#include <limits.h>
-#include <unistd.h>
-#include <time.h>
-#include <termios.h>
-#include <fcntl.h>
-#include <sys/wait.h>
-#include <dirent.h>
-#include <utime.h>
-
-#define DECL_GETLOGIN
-#define HAVE_APPEND
-#define HAVE_DIRENT
-#define HAVE_DUP2
-#define HAVE_FCNTL
-#define HAVE_GETCWD
-#define HAVE_MKDIR
-/* MKTIME is really ANSI C, but POSIX has it too ? */
-#define HAVE_MKTIME
-#define HAVE_POSIX_SIGNALS
-#define HAVE_RENAME
-#define HAVE_RMDIR
-#define HAVE_TERMIOS
-#define HAVE_TIMES
-#define HAVE_UTIME
-#define HAVE_WAITPID
-#define VOID_SIGNAL_HANDLERS
-
-#define ERRNO_NONBLOCK EAGAIN
-#define FCNTL_NONBLOCK O_NONBLOCK
-
-#ifdef _IRIX
-
-#define HAVE_DIR
-#define HAVE_SELECT
-#define HAVE_SIGCONTEXT
-#define HAVE_SOCKETS
-#define HAVE_SYMBOLIC_LINKS
-#define HAVE_UNIX_SOCKETS
-
-#endif /* _IRIX */
-
-#ifdef _AIX
-#define UNION_WAIT_STATUS
-#define SYSTEM_VARIANT "AIX"
-#endif /* _AIX */
-
-#else /* not _POSIX */
-#ifdef _BSD
-
-#include <fcntl.h>
-#include <sys/dir.h>
-#include <sgtty.h>
-#include <sys/time.h>
-#include <sys/wait.h>
-
-#define HAVE_APPEND
-#define HAVE_BSD_SIGNALS
-#define HAVE_BSD_TTY_DRIVER
-#define HAVE_DIR
-#define HAVE_DUP2
-#define HAVE_FCNTL
-#define HAVE_GETWD
-#define HAVE_MKDIR
-#define HAVE_RENAME
-#define HAVE_RMDIR
-#define HAVE_TIMES
-#define HAVE_WAIT3
-/* MORE/BSD has this -- do all 4.3 implementations? */
-/* #define HAVE_WAIT4 */
-#define UNION_WAIT_STATUS
-
-#if defined(_SUNOS4) || defined(sun4) || defined(_NEXTOS)
-#define VOID_SIGNAL_HANDLERS
-#endif
-
-#if defined(_SUNOS4) && defined(SIG_BLOCK)
-#define HAVE_POSIX_SIGNALS
+#ifdef _NEXTOS
+# define SYSTEM_VARIANT "NeXT"
#endif
-#define ERRNO_NONBLOCK EWOULDBLOCK
-#define FCNTL_NONBLOCK FNDELAY
-
-#else /* not _BSD */
-#ifdef _SYSV
-
-#include <time.h>
-#include <termio.h>
-#include <fcntl.h>
-
-#define HAVE_APPEND
-#define HAVE_FCNTL
-#define HAVE_GETCWD
-#define HAVE_TERMIO
-#define HAVE_TIMES
-#define HAVE_TIMEZONE
-
-#define AMBIGUOUS_NONBLOCK
-#define ERRNO_NONBLOCK EAGAIN
-#define FCNTL_NONBLOCK O_NDELAY
-
-#ifdef _SYSV3
-
-#include <dirent.h>
-
-#define HAVE_DIRENT
-#define HAVE_DUP2
-#define HAVE_MKDIR
-#define HAVE_RMDIR
-#define HAVE_SYSV3_SIGNALS
-#define VOID_SIGNAL_HANDLERS
-
-#else /* not _SYSV3 */
-#ifdef _HPUX
-
-#include <sys/wait.h>
-
-#define HAVE_BSD_SIGNALS
-#define HAVE_DUP2
-#define HAVE_FTRUNCATE
-#define HAVE_MKDIR
-#define HAVE_RENAME
-#define HAVE_RMDIR
-#define HAVE_WAIT3
-
-#if (_HPUX_VERSION < 65)
-
-#include <ndir.h>
-#define HAVE_DIR
-
-#else /* (_HPUX_VERSION >= 65) */
-
-#include <dirent.h>
-#define HAVE_DIRENT
-#define HAVE_POSIX_SIGNALS
-#define HAVE_WAITPID
-#define VOID_SIGNAL_HANDLERS
-#define HAVE_STATFS
-
-#endif /* _HPUX_VERSION */
+#ifdef __osf__
+# define SYSTEM_VARIANT "OSF"
+#endif
-#endif /* _HPUX */
-#endif /* _SYSV3 */
-#else /* not _SYSV */
#ifdef _PIXEL
+# define SYSTEM_VARIANT "Pixel"
+#endif
-#include <time.h>
-#include <sgtty.h>
-
-#define HAVE_BSD_TTY_DRIVER
-#define HAVE_DUMB_OPEN
-#define HAVE_DUP2
-#define HAVE_TIMES
-
-#endif /* _PIXEL */
-#endif /* _SYSV */
-#endif /* _BSD */
-#endif /* _POSIX */
-\f
-/* Conditionalizations that are independent of _POSIX. */
-
-#ifdef _BSD
-
-#define HAVE_BSD_JOB_CONTROL
-#define HAVE_FIONREAD
-#define HAVE_GETTIMEOFDAY
-#define HAVE_ITIMER
-#define HAVE_PTYS
-#define FIRST_PTY_LETTER 'p'
-#define HAVE_SELECT
-#define HAVE_SIGCONTEXT
-#define HAVE_SOCKETS
-#define HAVE_SYMBOLIC_LINKS
-#define HAVE_TRUNCATE
-#define HAVE_UNIX_SOCKETS
-#define HAVE_VFORK
-
-#ifdef __linux
-#define SYSTEM_VARIANT "GNU/Linux"
-#include <sys/time.h>
-#define HAVE_FTRUNCATE
-#define HAVE_STATFS
-#define HAVE_TIMEZONE
+#if defined(_SUNOS) || defined(_SUNOS3) || defined(_SUNOS4)
+# define SYSTEM_VARIANT "SunOS"
#endif
#ifdef _ULTRIX
-#define SYSTEM_VARIANT "Ultrix"
-#define HAVE_FTRUNCATE
-/* For now, they don't work */
-#undef HAVE_PTYS
+# define SYSTEM_VARIANT "Ultrix"
#endif
-#ifdef _NEXTOS
-#define SYSTEM_VARIANT "NeXT"
-#define HAVE_FTRUNCATE
-#define TIOCSIGSEND TIOCSIG
+#ifndef SYSTEM_VARIANT
+# define SYSTEM_VARIANT "unknown"
#endif
+\f
+#include "config.h"
-#ifdef __osf__
-#define HAVE_FTRUNCATE
-#define TIOCSIGSEND TIOCSIG
-#endif
+#include <errno.h>
+#include <grp.h>
+#include <pwd.h>
+#include <signal.h>
+#include <stdio.h>
+#include <sys/param.h>
+#include <sys/stat.h>
+#include <sys/times.h>
+#include <sys/types.h>
-#ifdef _SUNOS4
-#define HAVE_FTRUNCATE
-#ifdef sun4
-#define TIOCSIGSEND TIOCSIGNAL
-#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
#endif
-#ifdef apollo
-#define SYSTEM_VARIANT "Domain"
-#undef S_IFIFO
+/* GNU C library defines environ if __USE_GNU is defined. */
+#ifndef __USE_GNU
+ extern char ** environ;
#endif
-#ifdef _SUNOS
-
-#define SYSTEM_VARIANT "SunOS"
-
-#include <sys/vadvise.h>
-#ifdef _SUNOS3
-#define USE_HOSTENT_ADDR
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <string.h>
+#else
+# ifndef HAVE_STRCHR
+# define strchr index
+# define strrchr rindex
+# endif
+ extern char * strchr ();
+ extern char * strrchr ();
+# ifndef HAVE_MEMCPY
+# define memcpy(d, s, n) bcopy ((s), (d), (n))
+# define memmove(d, s, n) bcopy ((s), (d), (n))
+# endif
#endif
-#else /* not _SUNOS */
-
-#ifdef _BSD4_2
-#define USE_HOSTENT_ADDR
+#ifdef HAVE_SYS_FILE_H
+# include <sys/file.h>
#endif
-#endif /* _SUNOS */
-
-#ifndef SYSTEM_VARIANT
-#define SYSTEM_VARIANT "BSD"
+#ifdef HAVE_SYS_IOCTL_H
+# include <sys/ioctl.h>
+#else
+ extern int EXFUN (ioctl, (int, unsigned long, ...));
#endif
-#else /* not _BSD */
-#ifdef _HPUX
-
-#include <sys/ptyio.h>
-
-#define SYSTEM_VARIANT "HP-UX"
-#define HAVE_GETTIMEOFDAY
-#define HAVE_ITIMER
-#define HAVE_NICE
-#define HAVE_PTYS
-#define FIRST_PTY_LETTER 'p'
-#define HAVE_SELECT
-#define HAVE_SIGCONTEXT
-#define HAVE_SOCKETS
-#define HAVE_SYMBOLIC_LINKS
-#define HAVE_TRUNCATE
-#define HAVE_VFORK
-
-#if (_HPUX_VERSION >= 90)
-#define HAVE_POLL
-#endif
-
-#if (_HPUX_VERSION >= 65)
-/* Is this right for 800-series machines? */
-#define HAVE_UNIX_SOCKETS
-#endif
-
-#if (_HPUX_VERSION >= 65) || defined(hp9000s800)
-#include <bsdtty.h>
-#define HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_FCNTL_H
+# include <fcntl.h>
+#else
+ extern int EXFUN (open, (CONST char *, int, ...));
#endif
-#if (_HPUX_VERSION >= 70) || defined(hp9000s800)
-#define HAVE_FIONREAD
+#ifdef HAVE_LIMITS_H
+# include <limits.h>
#endif
-#if (_HPUX_VERSION <= 65)
-#define USE_HOSTENT_ADDR
+#ifdef HAVE_SYS_WAIT_H
+# include <sys/wait.h>
+#else
+# ifndef WIFEXITED
+# define WIFEXITED(_X) (((_X) & 0x00FF) == 0)
+# endif
+# ifndef WIFSTOPPED
+# define WIFSTOPPED(_X) (((_X) & 0x00FF) == 0x007F)
+# endif
+# ifndef WIFSIGNALED
+# define WIFSIGNALED(_X) \
+ ((((_X) & 0x00FF) != 0) && (((_X) & 0x00FF) != 0x007F))
+# endif
+# ifndef WEXITSTATUS
+# define WEXITSTATUS(_X) (((_X) & 0xFF00) >> 8)
+# endif
+# ifndef WTERMSIG
+# define WTERMSIG(_X) ((_X) & 0x007F)
+# endif
+# ifndef WSTOPSIG
+# define WSTOPSIG(_X) (((_X) & 0xFF00) >> 8)
+# endif
+ extern pid_t EXFUN (wait, (int *));
+# ifdef HAVE_WAITPID
+ extern pid_t EXFUN (waitpid, (pid_t, int *, int));
+# endif
+# ifdef HAVE_WAIT3
+ extern pid_t EXFUN (wait3, (int *, int, struct rusage *));
+# endif
#endif
-#else /* not _HPUX */
-#ifdef _AIX
-
-#define SYSTEM_VARIANT "AIX"
-#define HAVE_SOCKETS
-#define HAVE_VFORK
-
-#else /* not _AIX */
-#ifdef _SYSV4
-
-#define SYSTEM_VARIANT "ATT (Vr4)"
-
-#define HAVE_FIONREAD
-#define HAVE_FTRUNCATE
-#define HAVE_GETTIMEOFDAY
-#define HAVE_ITIMER
-#define HAVE_NICE
-#define HAVE_PTYS
-#define HAVE_SELECT
-#define HAVE_SIGCONTEXT
-#define HAVE_SOCKETS
-#define HAVE_SYMBOLIC_LINKS
-#define HAVE_TRUNCATE
-#define HAVE_UNIX_SOCKETS
-#define HAVE_VFORK
-
-#include <stropts.h>
-
-#undef PTY_ITERATION
-
-#define PTY_MASTER_NAME_SPRINTF(master_name) \
- sprintf ((master_name), "/dev/ptmx")
-
-#ifdef sonyrisc
-
-#define PTY_DECLARATIONS \
- extern int EXFUN (grantpt, (int)); \
- extern int EXFUN (unlockpt, (int)); \
- extern char * EXFUN (ptsname, (int)); \
- extern void EXFUN (sony_block_sigchld, (void)); \
- extern void EXFUN (sony_unblock_sigchld, (void))
-
-#define PTY_SLAVE_NAME_SPRINTF(slave_name, fd) \
-{ \
- sony_block_sigchld (); \
- grantpt (fd); \
- unlockpt (fd); \
- sprintf ((slave_name), "%s", (ptsname (fd))); \
- sony_unblock_sigchld (); \
-}
-
-#else /* not sonyrisc */
-
-#define PTY_DECLARATIONS \
- extern int EXFUN (grantpt, (int)); \
- extern int EXFUN (unlockpt, (int)); \
- extern char * EXFUN (ptsname, (int))
-
-#define PTY_SLAVE_NAME_SPRINTF(slave_name, fd) \
-{ \
- grantpt (fd); \
- unlockpt (fd); \
- sprintf ((slave_name), "%s", (ptsname (fd))); \
-}
-
-#endif /* not sonyrisc */
-
-/* Would be nice if HPUX and SYSV4 agreed on the name of this. */
-#define TIOCSIGSEND TIOCSIGNAL
-
-/* Must push various STREAMS modules onto the slave side of a PTY when
- it is opened. */
-
-#define SLAVE_PTY_P(filename) ((strncmp ((filename), "/dev/pts/", 9)) == 0)
-
-#define SETUP_SLAVE_PTY(fd) \
- (((ioctl ((fd), I_PUSH, "ptem")) >= 0) \
- && ((ioctl ((fd), I_PUSH, "ldterm")) >= 0) \
- && ((ioctl ((fd), I_PUSH, "ttcompat")) >= 0))
-
-#else /* not _SYSV4 */
-#ifdef _SYSV3
-
-#define SYSTEM_VARIANT "ATT (Vr3)"
-
-#else /* not _SYSV3 */
-#ifdef _SYSV
-
-#define SYSTEM_VARIANT "ATT (V)"
-
-#else /* not _SYSV */
-#ifdef _PIXEL
-
-#define SYSTEM_VARIANT "Pixel"
-
-#define HAVE_FIONREAD
-#define HAVE_NICE
-
-#else /* not _PIXEL */
-
-#define SYSTEM_VARIANT "unknown"
+#ifndef WUNTRACED
+# define WUNTRACED 0
+#endif
-#endif /* not _PIXEL */
-#endif /* not _SYSV */
-#endif /* not _SYSV3 */
-#endif /* not _SYSV4 */
-#endif /* not _AIX */
-#endif /* not _HPUX */
-#endif /* not _BSD */
-\f
-#ifdef VOID_SIGNAL_HANDLERS
-typedef void Tsignal_handler_result;
-#define SIGNAL_HANDLER_RETURN() return
+#ifdef HAVE_DIRENT_H
+# include <dirent.h>
+# define NAMLEN(_D) (strlen ((_D) -> d_name))
#else
-typedef int Tsignal_handler_result;
-#define SIGNAL_HANDLER_RETURN() return (0)
+# define dirent direct
+# define NAMLEN(_D) (strlen ((_D) -> d_namlen))
+# ifdef HAVE_SYS_NDIR_H
+# include <sys/ndir.h>
+# endif
+# ifdef HAVE_SYS_DIR_H
+# include <sys/dir.h>
+# endif
+# ifdef HAVE_NDIR_H
+# include <ndir.h>
+# endif
+#endif
+
+#ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# ifdef HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
#endif
-typedef Tsignal_handler_result (*Tsignal_handler) ();
-
-#ifndef SIG_ERR
-#define SIG_ERR ((Tsignal_handler) (-1))
+#ifdef HAVE_UTIME_H
+# include <utime.h>
+#else
+ /* It's really there. */
+ struct utimbuf
+ {
+ time_t actime;
+ time_t modtime;
+ };
+ extern int EXFUN (utime, (CONST char *, struct utimbuf *));
#endif
-#if !defined(SIGCHLD) && defined(SIGCLD)
-#define SIGCHLD SIGCLD
-#endif
-#if !defined(SIGABRT) && defined(SIGIOT)
-#define SIGABRT SIGIOT
+#ifdef HAVE_TERMIOS_H
+# include <termios.h>
+#else
+# ifdef HAVE_TERMIO_H
+# include <termio.h>
+# else
+# ifdef HAVE_SGTTY_H
+# include <sgtty.h>
+# endif
+# endif
#endif
-#ifndef HAVE_SIGCONTEXT
-struct sigcontext { long sc_sp, sc_pc; };
-#define HAVE_SIGCONTEXT
+#ifdef HAVE_SYS_POLL_H
+# include <sys/poll.h>
#endif
-/* Crufty, but it will work here. */
-#ifndef ENOSYS
-#define ENOSYS 0
+#if defined(HAVE_SOCKET) && defined(HAVE_GETHOSTBYNAME) && defined(HAVE_GETHOSTNAME)
+# define HAVE_SOCKETS
+# include <sys/socket.h>
+# include <netinet/in.h>
+# include <netdb.h>
+# ifdef HAVE_SYS_UN_H
+# include <sys/un.h>
+# ifdef AF_UNIX
+# define HAVE_UNIX_SOCKETS
+# endif
+# endif
#endif
-#ifndef HAVE_UTIME
-/* It's really there, but there may not be an include file. */
-
-struct utimbuf
-{
- time_t actime;
- time_t modtime;
-};
-
-extern int EXFUN (utime, (CONST char *, struct utimbuf *));
-#endif /* HAVE_UTIME */
-
-#ifdef UNION_WAIT_STATUS
-
-typedef union wait wait_status_t;
-
-#ifndef WEXITSTATUS
-#define WEXITSTATUS(_X) ((_X) . w_retcode)
+#ifdef HAVE_SYS_PTYIO_H
+#include <sys/ptyio.h>
#endif
-#ifndef WTERMSIG
-#define WTERMSIG(_X) ((_X) . w_termsig)
+#ifdef HAVE_BSDTTY_H
+#include <bsdtty.h>
#endif
-#ifndef WSTOPSIG
-#define WSTOPSIG(_X) ((_X) . w_stopsig)
+#ifdef HAVE_STROPTS_H
+#include <stropts.h>
#endif
-#else /* not UNION_WAIT_STATUS */
-
-typedef int wait_status_t;
-
-#ifndef WIFEXITED
-#define WIFEXITED(_X) (((_X) & 0377) == 0)
-#endif
+#include "intext.h"
+#include "dstack.h"
+#include "osscheme.h"
+#include "syscall.h"
+\f
+typedef RETSIGTYPE Tsignal_handler_result;
+typedef RETSIGTYPE (*Tsignal_handler) ();
-#ifndef WIFSTOPPED
-#define WIFSTOPPED(_X) (((_X) & 0377) == 0177)
+#ifdef VOID_SIGNAL_HANDLERS
+# define SIGNAL_HANDLER_RETURN() return
+#else
+# define SIGNAL_HANDLER_RETURN() return (0)
#endif
-#ifndef WIFSIGNALED
-#define WIFSIGNALED(_X) ((((_X) & 0377) != 0) && (((_X) & 0377) != 0177))
+/* Crufty, but it will work here. */
+#ifndef ENOSYS
+# define ENOSYS 0
#endif
-
-#ifndef WEXITSTATUS
-#define WEXITSTATUS(_X) (((_X) >> 8) & 0377)
+\f
+#ifndef SIG_ERR
+# define SIG_ERR ((Tsignal_handler) (-1))
#endif
-#ifndef WTERMSIG
-#define WTERMSIG(_X) ((_X) & 0177)
+#if !defined(SIGCHLD) && defined(SIGCLD)
+# define SIGCHLD SIGCLD
#endif
-
-#ifndef WSTOPSIG
-#define WSTOPSIG(_X) (((_X) >> 8) & 0377)
+#if !defined(SIGABRT) && defined(SIGIOT)
+# define SIGABRT SIGIOT
#endif
-#endif /* UNION_WAIT_STATUS */
-\f
/* Provide null defaults for all the signals we're likely to use so we
aren't continually testing to see if they're defined. */
#ifndef SIGLOST
-#define SIGLOST 0
+# define SIGLOST 0
#endif
#ifndef SIGWINCH
-#define SIGWINCH 0
+# define SIGWINCH 0
+#endif
+#ifndef SIGWINDOW
+# define SIGWINDOW 0
+#endif
+#ifndef SIGXCPU
+# define SIGXCPU 0
+#endif
+#ifndef SIGXFSZ
+# define SIGXFSZ 0
#endif
#ifndef SIGURG
-#define SIGURG 0
+# define SIGURG 0
#endif
#ifndef SIGIO
-#define SIGIO 0
+# define SIGIO 0
#endif
#ifndef SIGUSR1
-#define SIGUSR1 0
+# define SIGUSR1 0
#endif
#ifndef SIGUSR2
-#define SIGUSR2 0
+# define SIGUSR2 0
#endif
#ifndef SIGVTALRM
-#define SIGVTALRM 0
+# define SIGVTALRM 0
#endif
#ifndef SIGABRT
-#define SIGABRT 0
+# define SIGABRT 0
#endif
#ifndef SIGPWR
-#define SIGPWR 0
+# define SIGPWR 0
#endif
#ifndef SIGPROF
-#define SIGPROF 0
+# define SIGPROF 0
#endif
#ifndef SIGSTOP
-#define SIGSTOP 0
+# define SIGSTOP 0
#endif
#ifndef SIGTSTP
-#define SIGTSTP 0
+# define SIGTSTP 0
#endif
#ifndef SIGCONT
-#define SIGCONT 0
+# define SIGCONT 0
#endif
#ifndef SIGCHLD
-#define SIGCHLD 0
+# define SIGCHLD 0
#endif
#ifndef SIGTTIN
-#define SIGTTIN 0
+# define SIGTTIN 0
#endif
#ifndef SIGTTOU
-#define SIGTTOU 0
+# define SIGTTOU 0
#endif
#ifndef SIGBUS
-#define SIGBUS 0
+# define SIGBUS 0
#endif
#ifndef SIGEMT
-#define SIGEMT 0
+# define SIGEMT 0
#endif
#ifndef SIGSYS
-#define SIGSYS 0
+# define SIGSYS 0
#endif
\f
/* constants for access() */
#ifndef R_OK
-#define R_OK 4
-#define W_OK 2
-#define X_OK 1
-#define F_OK 0
+# define R_OK 4
+# define W_OK 2
+# define X_OK 1
+# define F_OK 0
#endif
#ifndef MAXPATHLEN
-#define MAXPATHLEN 1024
+# define MAXPATHLEN 1024
#endif
-#ifdef __STDC__
-#define ALERT_CHAR '\a'
-#define ALERT_STRING "\a"
+#ifdef HAVE_STDC
+# define ALERT_CHAR '\a'
+# define ALERT_STRING "\a"
#else
-#define ALERT_CHAR '\007'
-#define ALERT_STRING "\007"
+# define ALERT_CHAR '\007'
+# define ALERT_STRING "\007"
#endif
#ifndef STDIN_FILENO
-#define STDIN_FILENO 0
-#define STDOUT_FILENO 1
-#define STDERR_FILENO 2
+# define STDIN_FILENO 0
+# define STDOUT_FILENO 1
+# define STDERR_FILENO 2
#endif
/* constants for open() and fcntl() */
#ifndef O_RDONLY
-#define O_RDONLY 0
-#define O_WRONLY 1
-#define O_RDWR 2
+# define O_RDONLY 0
+# define O_WRONLY 1
+# define O_RDWR 2
#endif
/* mode bit definitions for open(), creat(), and chmod() */
#ifndef S_IRWXU
-#define S_IRWXU 0700
-#define S_IRWXG 0070
-#define S_IRWXO 0007
+# define S_IRWXU 0700
+# define S_IRWXG 0070
+# define S_IRWXO 0007
#endif
#ifndef S_IRUSR
-#define S_IRUSR 0400
-#define S_IWUSR 0200
-#define S_IXUSR 0100
-#define S_IRGRP 0040
-#define S_IWGRP 0020
-#define S_IXGRP 0010
-#define S_IROTH 0004
-#define S_IWOTH 0002
-#define S_IXOTH 0001
+# define S_IRUSR 0400
+# define S_IWUSR 0200
+# define S_IXUSR 0100
+# define S_IRGRP 0040
+# define S_IWGRP 0020
+# define S_IXGRP 0010
+# define S_IROTH 0004
+# define S_IWOTH 0002
+# define S_IXOTH 0001
#endif
#define MODE_REG (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
/* constants for lseek() */
#ifndef SEEK_SET
-#define SEEK_SET 0
-#define SEEK_CUR 1
-#define SEEK_END 2
+# define SEEK_SET 0
+# define SEEK_CUR 1
+# define SEEK_END 2
#endif
\f
-#ifndef DECL_GETLOGIN
-extern char * EXFUN (getlogin, (void));
+#ifdef HAVE_GETLOGIN
+# ifndef HAVE_UNISTD_H
+ extern char * EXFUN (getlogin, (void));
+# endif
+#endif
+
+#ifndef STDC_HEADERS
+# ifndef HAVE_MALLOC_H
+ extern PTR EXFUN (malloc, (size_t));
+ extern PTR EXFUN (realloc, (PTR, size_t));
+# endif
+ extern char * EXFUN (getenv, (CONST char *));
#endif
#define UX_abort abort
+#define UX_accept accept
#define UX_access access
#define UX_alarm alarm
+#define UX_bind bind
#define UX_chdir chdir
#define UX_chmod chmod
#define UX_close close
+#define UX_connect connect
#define UX_ctime ctime
#define UX_dup dup
+#define UX_fcntl fcntl
#define UX_free free
#define UX_fstat fstat
#define UX_fstatfs fstatfs
+#define UX_ftruncate ftruncate
#define UX_getegid getegid
#define UX_getenv getenv
#define UX_geteuid geteuid
#define UX_getgid getgid
#define UX_getgrgid getgrgid
+#define UX_gethostbyname gethostbyname
#define UX_gethostname gethostname
#define UX_getlogin getlogin
#define UX_getpid getpid
#define UX_getpwnam getpwnam
#define UX_getpwuid getpwuid
+#define UX_getservbyname getservbyname
+#define UX_gettimeofday gettimeofday
#define UX_getuid getuid
#define UX_gmtime gmtime
#define UX_ioctl ioctl
#define UX_link link
+#define UX_listen listen
#define UX_localtime localtime
#define UX_lseek lseek
#define UX_malloc malloc
#define UX_mknod mknod
#define UX_mktime mktime
+#define UX_open open
#define UX_pause pause
#define UX_pipe pipe
#define UX_read read
+#define UX_readlink readlink
#define UX_realloc realloc
+#define UX_rmdir rmdir
+#define UX_select select
+#define UX_setitimer setitimer
#define UX_signal signal
#define UX_sleep sleep
+#define UX_socket socket
#define UX_stat stat
#define UX_statfs statfs
+#define UX_symlink symlink
#define UX_system system
#define UX_time time
+#define UX_times times
+#define UX_truncate truncate
#define UX_unlink unlink
#define UX_utime utime
-#define UX_write write
+#define UX_vfork vfork
#define UX_wait wait
+#define UX_write write
-extern PTR EXFUN (malloc, (unsigned int size));
-extern PTR EXFUN (realloc, (PTR ptr, unsigned int size));
-extern char * EXFUN (getenv, (CONST char * name));
-
-#ifndef __linux
-/* <unistd.h> in linux libc 2.3.3 has
- extern int gethostname (char *__name, size_t __len); */
-# ifndef _HPUX
-/* <unistd.h> in HP-UX has mis-matching prototype
- The following is as specified by OSF/1 Programmer's reference.
- */
-extern int EXFUN (gethostname, (char * name, int size));
-# endif /* _HPUX */
-#endif /* linux */
-
-#ifdef HAVE_FCNTL
-#define UX_fcntl fcntl
+#ifdef HAVE_SYMLINK
+#define UX_lstat lstat
+#else
+#define UX_lstat stat
#endif
-
-#ifdef HAVE_TRUNCATE
-#define UX_ftruncate ftruncate
-#define UX_truncate truncate
+\f
+#ifdef HAVE_DUP2
+# define UX_dup2 dup2
+#else
+# ifdef HAVE_FCNTL
+ extern int EXFUN (UX_dup2, (int, int));
+# define EMULATE_DUP2
+# define HAVE_DUP2
+# endif
#endif
-#ifdef HAVE_VFORK
-#define UX_vfork vfork
+#ifdef HAVE_GETCWD
+# define UX_getcwd getcwd
#else
-#define UX_vfork fork
+ extern char * EXFUN (UX_getcwd, (char *, size_t));
+# define EMULATE_GETCWD
+# define HAVE_GETCWD
#endif
-#ifdef HAVE_SYMBOLIC_LINKS
-#define UX_lstat lstat
-#define UX_readlink readlink
-#define UX_symlink symlink
+#ifdef HAVE_MKDIR
+# define UX_mkdir mkdir
#else
-#define UX_lstat stat
+ extern int EXFUN (UX_mkdir, (CONST char *, mode_t));
+# define EMULATE_MKDIR
+# define HAVE_MKDIR
#endif
-extern void EXFUN (UX_prim_check_errno, (enum syscall_names name));
+#ifdef HAVE_RENAME
+# define UX_rename rename
+#else
+ extern int EXFUN (UX_rename, (CONST char *, CONST char *));
+# define EMULATE_RENAME
+# define HAVE_RENAME
+#endif
-#define STD_VOID_SYSTEM_CALL(name, expression) \
-{ \
- while ((expression) < 0) \
- if (errno != EINTR) \
- error_system_call (errno, (name)); \
-}
+#ifdef HAVE_WAITPID
+# define UX_waitpid waitpid
+#else
+# ifdef HAVE_WAIT3
+ extern int EXFUN (UX_waitpid, (pid_t, int *, int));
+# define EMULATE_WAITPID
+# define HAVE_WAITPID
+# endif
+#endif
-#define STD_UINT_SYSTEM_CALL(name, result, expression) \
-{ \
- while (((result) = (expression)) < 0) \
- if (errno != EINTR) \
- error_system_call (errno, (name)); \
-}
+#ifdef HAVE_CTERMID
+# define UX_ctermid ctermid
+#else
+ extern char * EXFUN (UX_ctermid, (char * s));
+# define EMULATE_CTERMID
+#endif
-#define STD_PTR_SYSTEM_CALL(name, result, expression) \
-{ \
- while (((result) = (expression)) == 0) \
- if (errno != EINTR) \
- error_system_call (errno, (name)); \
-}
+#ifdef HAVE_KILL
+# define UX_kill kill
+#else
+ extern int EXFUN (UX_kill, (pid_t pid, int sig));
+# define EMULATE_KILL
+#endif
+\f
+#ifdef HAVE_POLL
+# ifndef INFTIM
+# define INFTIM (-1)
+# endif
+#else
+# ifdef FD_SET
+# define SELECT_TYPE fd_set
+# else
+# define SELECT_TYPE int
+# define FD_SETSIZE ((sizeof (int)) * CHAR_BIT)
+# define FD_SET(n, p) ((*(p)) |= (1 << (n)))
+# define FD_CLR(n, p) ((*(p)) &= ~(1 << (n)))
+# define FD_ISSET(n, p) (((*(p)) & (1 << (n))) != 0)
+# define FD_ZERO(p) ((*(p)) = 0)
+# endif
+#endif
+
+#ifdef _POSIX_VERSION
+# define ERRNO_NONBLOCK EAGAIN
+# define FCNTL_NONBLOCK O_NONBLOCK
+#else
+# ifdef EWOULDBLOCK
+# define ERRNO_NONBLOCK EWOULDBLOCK
+# define FCNTL_NONBLOCK FNDELAY
+# else
+# define AMBIGUOUS_NONBLOCK
+# ifdef EAGAIN
+# define ERRNO_NONBLOCK EAGAIN
+# endif
+# define FCNTL_NONBLOCK O_NDELAY
+# endif
+#endif
\f
-#ifdef HAVE_TERMIOS
+#if defined(HAVE_GRANTPT) && defined(HAVE_STROPTS_H) && !defined(__osf__) && !defined(__linux__)
+ /* Must push various STREAMS modules onto the slave side of a PTY
+ when it is opened. */
+# define SLAVE_PTY_P(filename) ((strncmp ((filename), "/dev/pts/", 9)) == 0)
+ extern int EXFUN (UX_setup_slave_pty, (int));
+# define SETUP_SLAVE_PTY UX_setup_slave_pty
+#endif
+
+#ifndef TIOCSIGSEND
+# ifdef TIOCSIGNAL
+# define TIOCSIGSEND TIOCSIGNAL
+# else
+# ifdef TIOCSIG
+# define TIOCSIGSEND TIOCSIG
+# endif
+# endif
+#endif
+
+#ifdef HAVE_TERMIOS_H
typedef struct
{
struct termios tio;
-#ifdef _HPUX
+#ifdef HAVE_STRUCT_LTCHARS
struct ltchars ltc;
#endif
} Ttty_state;
#define UX_tcgetattr tcgetattr
#define UX_tcsetattr tcsetattr
-#else /* not HAVE_TERMIOS */
+#else /* not HAVE_TERMIOS_H */
-extern int EXFUN (UX_tcdrain, (int fd));
-extern int EXFUN (UX_tcflush, (int fd, int queue_selector));
+extern int EXFUN (UX_tcdrain, (int));
+extern int EXFUN (UX_tcflush, (int, int));
/* These values chosen to match the ioctl TCFLSH argument for termio. */
#define TCIFLUSH 0
#define TCOFLUSH 1
#define TCIOFLUSH 2
-#ifdef HAVE_TERMIO
+#ifdef HAVE_TERMIO_H
typedef struct
{
struct termio tio;
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
struct ltchars ltc;
#endif
} Ttty_state;
-#else /* not HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
typedef struct
{
struct sgttyb sg;
struct tchars tc;
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
struct ltchars ltc;
#endif
int lmode;
} Ttty_state;
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIO */
-#endif /* HAVE_TERMIOS */
-
-extern int EXFUN (UX_terminal_get_state, (int fd, Ttty_state * s));
-extern int EXFUN (UX_terminal_set_state, (int fd, Ttty_state * s));
-\f
-#ifdef _POSIX
-#define UX_getpgrp getpgrp
-#define UX_setsid setsid
-#else
-#ifdef _SYSV
-#define UX_getpgrp getpgrp
-#define UX_setsid setpgrp
-#else /* not _SYSV */
-extern pid_t EXFUN (UX_getpgrp, (void));
-extern pid_t EXFUN (UX_setsid, (void));
-#endif /* _SYSV */
-#endif /* _POSIX */
+#endif /* not HAVE_SGTTY_H */
+#endif /* not HAVE_TERMIO_H */
+#endif /* not HAVE_TERMIOS_H */
-#ifdef _POSIX
+extern int EXFUN (UX_terminal_get_state, (int, Ttty_state *));
+extern int EXFUN (UX_terminal_set_state, (int, Ttty_state *));
-#define UX_setpgid setpgid
-#define UX_tcgetpgrp tcgetpgrp
-#define UX_tcsetpgrp tcsetpgrp
-
-#else /* not _POSIX */
-
-extern pid_t EXFUN (UX_tcgetpgrp, (int fd));
-extern int EXFUN (UX_tcsetpgrp, (int fd, pid_t pgrp_id));
-
-#ifdef HAVE_BSD_JOB_CONTROL
-
-#ifdef _SYSV
-#define UX_setpgid setpgrp2
+#ifdef _POSIX_VERSION
+# define UX_getpgrp getpgrp
+# define UX_setsid setsid
+# define UX_setpgid setpgid
+# define UX_tcgetpgrp tcgetpgrp
+# define UX_tcsetpgrp tcsetpgrp
#else
-#define UX_setpgid setpgrp
+# if defined(HAVE_GETPGRP) && defined(HAVE_SETPGRP)
+# ifdef GETPGRP_VOID
+# define UX_getpgrp getpgrp
+# else
+ extern pid_t EXFUN (UX_getpgrp, (void));
+# define EMULATE_GETPGRP
+# endif
+# ifdef SETPGRP_VOID
+# define UX_setsid setpgrp
+# else
+ extern pid_t EXFUN (UX_setsid, (void));
+# define EMULATE_SETSID
+# endif
+# ifdef HAVE_SETPGRP2
+# define UX_setpgid setpgrp2
+# else
+# ifdef SETPGRP_VOID
+ extern int UX_setpgid (pid_t, pid_t);
+# define EMULATE_SETPGID
+# else
+# define UX_setpgid setpgrp
+# endif
+# endif
+# endif
+ extern pid_t EXFUN (UX_tcgetpgrp, (int));
+# define EMULATE_TCGETPGRP
+ extern int EXFUN (UX_tcsetpgrp, (int, pid_t));
+# define EMULATE_TCSETPGRP
#endif
-
-#endif /* HAVE_BSD_JOB_CONTROL */
-#endif /* _POSIX */
\f
-#ifdef HAVE_GETTIMEOFDAY
-#define UX_gettimeofday gettimeofday
-#endif
-#ifdef HAVE_ITIMER
-#define UX_setitimer setitimer
-#endif
-#ifdef HAVE_RMDIR
-#define UX_rmdir rmdir
-#endif
-#ifdef HAVE_TIMES
-#define UX_times times
-#endif
-#ifdef HAVE_SOCKETS
-#define UX_connect connect
-#define UX_gethostbyname gethostbyname
-#define UX_getservbyname getservbyname
-#define UX_socket socket
-#define UX_bind bind
-#define UX_listen listen
-#define UX_accept accept
-#endif
-
-#ifdef HAVE_DUMB_OPEN
-extern int EXFUN (UX_open, (CONST char * name, int oflag, mode_t mode));
-#else
-#define UX_open open
-#endif
-
-#ifdef HAVE_DUP2
-#define UX_dup2 dup2
-#else
-#ifdef HAVE_FCNTL
-#define EMULATE_DUP2
-#define HAVE_DUP2
-extern int EXFUN (UX_dup2, (int fd, int fd2));
-#endif
-#endif
-
-#ifdef HAVE_GETCWD
-#define UX_getcwd getcwd
-#else
-#define EMULATE_GETCWD
-#define HAVE_GETCWD
-extern char * EXFUN (UX_getcwd, (char * buffer, size_t length));
-#endif
-
-#ifdef HAVE_MKDIR
-#define UX_mkdir mkdir
-#else
-#define EMULATE_MKDIR
-#define HAVE_MKDIR
-extern int EXFUN (UX_mkdir, (CONST char * name, mode_t mode));
-#endif
-
-#ifdef HAVE_RENAME
-#define UX_rename rename
-#else
-#define EMULATE_RENAME
-#define HAVE_RENAME
-extern int EXFUN (UX_rename, (CONST char * from_name, CONST char * to_name));
-#endif
-
-#ifdef HAVE_WAITPID
-#define UX_waitpid waitpid
-#else /* not HAVE_WAITPID */
-#ifdef HAVE_WAIT3
-#define EMULATE_WAITPID
-#define HAVE_WAITPID
-extern int EXFUN
- (UX_waitpid, (pid_t pid, wait_status_t * stat_loc, int options));
-#endif /* HAVE_WAIT3 */
-#endif /* HAVE_WAITPID */
-
-#ifndef WUNTRACED
-#define WUNTRACED 0
-#endif
-
-#ifdef HAVE_SELECT
-#define UX_select select
-#endif /* HAVE_SELECT */
-\f
-#ifdef _BSD
-#define BSD_DEV_TTY "/dev/tty"
-#endif
-
-#if !defined(_POSIX) && defined(_BSD) && !defined(_SUNOS)
-#define L_ctermid ((strlen (BSD_DEV_TTY)) + 1);
-extern char * EXFUN (UX_ctermid, (char * s));
-extern int EXFUN (UX_kill, (pid_t pid, int sig));
-#else
-#define UX_ctermid ctermid
-#define UX_kill kill
-#endif
-
-#ifdef HAVE_POSIX_SIGNALS
+#ifdef HAVE_SIGACTION
#define UX_sigemptyset sigemptyset
#define UX_sigfillset sigfillset
#define UX_sigaction sigaction
#define UX_sigsuspend sigsuspend
#define UX_sigprocmask sigprocmask
+#define HAVE_POSIX_SIGNALS
-#else /* not HAVE_POSIX_SIGNALS */
+#else /* not HAVE_SIGACTION */
typedef long sigset_t;
-extern int EXFUN (UX_sigemptyset, (sigset_t * set));
-extern int EXFUN (UX_sigfillset, (sigset_t * set));
-extern int EXFUN (UX_sigaddset, (sigset_t * set, int signo));
-extern int EXFUN (UX_sigdelset, (sigset_t * set, int signo));
-extern int EXFUN (UX_sigismember, (CONST sigset_t * set, int signo));
+extern int EXFUN (UX_sigemptyset, (sigset_t *));
+extern int EXFUN (UX_sigfillset, (sigset_t *));
+extern int EXFUN (UX_sigaddset, (sigset_t *, int));
+extern int EXFUN (UX_sigdelset, (sigset_t *, int));
+extern int EXFUN (UX_sigismember, (CONST sigset_t *, int));
+
+#ifdef HAVE_SIGVEC
+# define UX_sigvec sigvec
+#else
+# ifdef HAVE_SIGVECTOR
+# define UX_sigvec sigvector
+# define HAVE_SIGVEC
+# endif
+#endif
-#ifdef HAVE_BSD_SIGNALS
+#ifdef HAVE_SIGVEC
struct sigaction
{
};
extern int EXFUN
- (UX_sigaction,
- (int signo, CONST struct sigaction * act, struct sigaction * oact));
-extern int EXFUN
- (UX_sigprocmask, (int how, CONST sigset_t * set, sigset_t * oset));
-extern int EXFUN (UX_sigsuspend, (CONST sigset_t * set));
+ (UX_sigaction, (int, CONST struct sigaction *, struct sigaction *));
+extern int EXFUN (UX_sigprocmask, (int, CONST sigset_t *, sigset_t *));
+extern int EXFUN (UX_sigsuspend, (CONST sigset_t *));
#define SIG_BLOCK 0
#define SIG_UNBLOCK 1
#define SIG_SETMASK 2
#define HAVE_POSIX_SIGNALS
-#else /* not HAVE_BSD_SIGNALS */
-#ifdef HAVE_SYSV3_SIGNALS
+#else /* not HAVE_SIGVEC */
+#ifdef HAVE_SIGHOLD
#define UX_sigset sigset
#define UX_sighold sighold
#define UX_sigrelse sigrelse
-#endif /* HAVE_SYSV3_SIGNALS */
-#endif /* HAVE_BSD_SIGNALS */
-#endif /* HAVE_POSIX_SIGNALS */
+#endif /* HAVE_SIGHOLD */
+#endif /* HAVE_SIGVEC */
+#endif /* HAVE_SIGACTION */
\f
-#ifdef _POSIX
-
-#define HAVE_SIGSET_OPS
-
-#ifdef EMULATE_FPATHCONF
-
-/* These values match HP-UX, and the index in the table in the
- OSF/1 Programmer's reference.
- */
-
-extern long EXFUN (fpathconf, (int, int));
-
-#ifndef _PC_VDISABLE
-# define _PC_VDISABLE 8
-#endif
-
-#endif /* EMULATE_FPATHCONF */
-
-#ifdef EMULATE_SYSCONF
-
-extern long EXFUN (sysconf, (int));
-
-/* These values match HP-UX, and the index in the table in the
- OSF/1 Programmer's reference.
-
- Note: The code assumes that if one is present, the rest
- are too. Otherwise there is no simple way to guarantee
- that non-conflicting values have been chosen.
- */
-
-#ifndef _SC_CHILD_MAX
-# define _SC_CHILD_MAX 1
-# define _SC_CLK_TCK 2
-# define _SC_OPEN_MAX 4
-# define _SC_JOB_CONTROL 5
-#endif
-
-#endif /* EMULATE_SYSCONF */
-
-extern cc_t EXFUN (UX_PC_VDISABLE, (int fildes));
-extern clock_t EXFUN (UX_SC_CLK_TCK, (void));
-#define UX_SC_OPEN_MAX() ((size_t) (sysconf (_SC_OPEN_MAX)))
-#define UX_SC_CHILD_MAX() ((size_t) (sysconf (_SC_CHILD_MAX)))
-
-#ifdef _POSIX_JOB_CONTROL
-#define UX_SC_JOB_CONTROL() 1
-#else
-#define UX_SC_JOB_CONTROL() ((sysconf (_SC_JOB_CONTROL)) >= 0)
-#endif
-
-#else /* not _POSIX */
-
-#ifdef _SUNOS4
-#define HAVE_SIGSET_OPS
-#endif
-
-#define UX_PC_VDISABLE(fildes) '\377'
-
-#ifdef OPEN_MAX
-#define UX_SC_OPEN_MAX() OPEN_MAX
-#else
-#ifdef _NFILE
-#define UX_SC_OPEN_MAX() _NFILE
-#else
-#define UX_SC_OPEN_MAX() 16
-#endif
-#endif
-
-#ifdef CHILD_MAX
-#define UX_SC_CHILD_MAX() CHILD_MAX
-#else
-#define UX_SC_CHILD_MAX() 6
-#endif
+#ifdef _POSIX_VERSION
+
+# ifndef HAVE_FPATHCONF
+ extern long EXFUN (fpathconf, (int, int));
+# define EMULATE_FPATHCONF
+# endif
+
+# ifndef HAVE_SYSCONF
+ extern long EXFUN (sysconf, (int));
+# define EMULATE_SYSCONF
+# endif
+
+ extern cc_t EXFUN (UX_PC_VDISABLE, (int fildes));
+ extern clock_t EXFUN (UX_SC_CLK_TCK, (void));
+# define UX_SC_OPEN_MAX() ((size_t) (sysconf (_SC_OPEN_MAX)))
+# define UX_SC_CHILD_MAX() ((size_t) (sysconf (_SC_CHILD_MAX)))
+
+# ifdef _POSIX_JOB_CONTROL
+# define UX_SC_JOB_CONTROL() 1
+# else
+# define UX_SC_JOB_CONTROL() ((sysconf (_SC_JOB_CONTROL)) >= 0)
+# endif
+
+#else /* not _POSIX_VERSION */
+
+# define UX_PC_VDISABLE(fildes) '\377'
+
+# ifdef OPEN_MAX
+# define UX_SC_OPEN_MAX() OPEN_MAX
+# else
+# ifdef _NFILE
+# define UX_SC_OPEN_MAX() _NFILE
+# else
+# define UX_SC_OPEN_MAX() 16
+# endif
+# endif
+
+# ifdef CHILD_MAX
+# define UX_SC_CHILD_MAX() CHILD_MAX
+# else
+# define UX_SC_CHILD_MAX() 6
+# endif
+
+# ifdef CLK_TCK
+# define UX_SC_CLK_TCK() CLK_TCK
+# else
+# ifdef HZ
+# define UX_SC_CLK_TCK() HZ
+# else
+# define UX_SC_CLK_TCK() 60
+# endif
+# endif
+
+# ifdef TIOCGPGRP
+# define UX_SC_JOB_CONTROL() 1
+# else
+# define UX_SC_JOB_CONTROL() 0
+# endif
+
+#endif /* not _POSIX_VERSION */
+\f
+extern void EXFUN (UX_prim_check_errno, (enum syscall_names name));
-#ifdef CLK_TCK
-#define UX_SC_CLK_TCK() CLK_TCK
-#else
-#ifdef HZ
-#define UX_SC_CLK_TCK() HZ
-#else
-#define UX_SC_CLK_TCK() 60
-#endif
-#endif
+#define STD_VOID_SYSTEM_CALL(name, expression) \
+{ \
+ while ((expression) < 0) \
+ if (errno != EINTR) \
+ error_system_call (errno, (name)); \
+}
-#ifdef HAVE_BSD_JOB_CONTROL
-#define UX_SC_JOB_CONTROL() 1
-#else
-#define UX_SC_JOB_CONTROL() 0
-#endif
+#define STD_UINT_SYSTEM_CALL(name, result, expression) \
+{ \
+ while (((result) = (expression)) < 0) \
+ if (errno != EINTR) \
+ error_system_call (errno, (name)); \
+}
-#endif /* _POSIX */
+#define STD_PTR_SYSTEM_CALL(name, result, expression) \
+{ \
+ while (((result) = (expression)) == 0) \
+ if (errno != EINTR) \
+ error_system_call (errno, (name)); \
+}
#endif /* SCM_UX_H */
/* -*-C-*-
-$Id: uxctty.c,v 1.13 1999/01/02 06:11:34 cph Exp $
+$Id: uxctty.c,v 1.14 2000/12/05 21:23:48 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Ttty_state s;
if ((get_terminal_state (ctty_fildes, (&s))) == 0)
{
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
(ic -> quit) = ((s . tio . c_cc) [VQUIT]);
(ic -> intrpt) = ((s . tio . c_cc) [VINTR]);
(ic -> tstp) = ((s . tio . c_cc) [VSUSP]);
#ifdef VDSUSP
(ic -> dtstp) = ((s . tio . c_cc) [VDSUSP]);
#else /* not VDSUSP */
-#ifdef _HPUX
+#ifdef __HPUX__
(ic -> dtstp) = (s . ltc . t_dsuspc);
-#endif /* _HPUX */
+#endif /* __HPUX__ */
#endif /* not VDSUSP */
-#else /* not HAVE_TERMIOS */
-#ifdef HAVE_TERMIO
+#else /* not HAVE_TERMIOS_H */
+#ifdef HAVE_TERMIO_H
(ic -> quit) = ((s . tio . c_cc) [VQUIT]);
(ic -> intrpt) = ((s . tio . c_cc) [VINTR]);
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
(ic -> tstp) = (s . ltc . t_suspc);
(ic -> dtstp) = (s . ltc . t_dsuspc);
-#else /* not HAVE_BSD_JOB_CONTROL */
+#else /* not HAVE_STRUCT_LTCHARS */
{
cc_t disabled_char = (UX_PC_VDISABLE (ctty_fildes));
(ic -> tstp) = disabled_char;
(ic -> dtstp) = disabled_char;
}
-#endif /* not HAVE_BSD_JOB_CONTROL */
+#endif /* not HAVE_STRUCT_LTCHARS */
-#else /* not HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
(ic -> quit) = (s . tc . t_quitc);
(ic -> intrpt) = (s . tc . t_intrc);
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
(ic -> tstp) = (s . ltc . t_suspc);
(ic -> dtstp) = (s . ltc . t_dsuspc);
-#else /* not HAVE_BSD_JOB_CONTROL */
+#else /* not HAVE_STRUCT_LTCHARS */
{
cc_t disabled_char = (UX_PC_VDISABLE (ctty_fildes));
(ic -> tstp) = disabled_char;
(ic -> dtstp) = disabled_char;
}
-#endif /* not HAVE_BSD_JOB_CONTROL */
+#endif /* not HAVE_STRUCT_LTCHARS */
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIO */
-#endif /* HAVE_TERMIOS */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIO_H */
+#endif /* HAVE_TERMIOS_H */
}
else
{
Ttty_state s;
if ((get_terminal_state (ctty_fildes, (&s))) == 0)
{
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
((s . tio . c_cc) [VQUIT]) = (ic -> quit);
((s . tio . c_cc) [VINTR]) = (ic -> intrpt);
((s . tio . c_cc) [VSUSP]) = (ic -> tstp);
#ifdef VDSUSP
((s . tio . c_cc) [VDSUSP]) = (ic -> dtstp);
#else /* not VDSUSP */
-#ifdef _HPUX
+#ifdef __HPUX__
(s . ltc . t_suspc) = (ic -> tstp);
(s . ltc . t_dsuspc) = (ic -> dtstp);
-#endif /* _HPUX */
+#endif /* __HPUX__ */
#endif /* not VDSUSP */
-#else /* not HAVE_TERMIOS */
-#ifdef HAVE_TERMIO
+#else /* not HAVE_TERMIOS_H */
+#ifdef HAVE_TERMIO_H
((s . tio . c_cc) [VQUIT]) = (ic -> quit);
((s . tio . c_cc) [VINTR]) = (ic -> intrpt);
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
(s . ltc . t_suspc) = (ic -> tstp);
(s . ltc . t_dsuspc) = (ic -> dtstp);
#endif
-#else /* not HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
(s . tc . t_quitc) = (ic -> quit);
(s . tc . t_intrc) = (ic -> intrpt);
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
(s . ltc . t_suspc) = (ic -> tstp);
(s . ltc . t_dsuspc) = (ic -> dtstp);
#endif
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIO */
-#endif /* HAVE_TERMIOS */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIO_H */
+#endif /* HAVE_TERMIOS_H */
set_terminal_state (ctty_fildes, (&s));
}
}
/* -*-C-*-
-$Id: uxenv.c,v 1.19 1999/12/21 19:21:31 cph Exp $
+$Id: uxenv.c,v 1.20 2000/12/05 21:23:49 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
(buffer -> minute) = (ts -> tm_min);
(buffer -> second) = (ts -> tm_sec);
(buffer -> daylight_savings_time) = (ts -> tm_isdst);
+#ifdef HAVE_TM_GMTOFF
+ /* tm_gmtoff is in minutes east of UTC; we need minutes west. */
+ (buffer -> time_zone) = (- (ts -> TM_GMTOFF));
+ if ((ts -> tm_isdst) > 0)
+ (buffer -> time_zone) += 3600;
+#else
#ifdef HAVE_TIMEZONE
- (buffer -> time_zone) = timezone;
+ (buffer -> time_zone) = TIMEZONE;
#else
(buffer -> time_zone) = INT_MAX;
+#endif
#endif
{
/* In localtime() encoding, 0 is Sunday; in ours, it's Monday. */
(buffer -> hour) = (ts -> tm_hour);
(buffer -> minute) = (ts -> tm_min);
(buffer -> second) = (ts -> tm_sec);
- (buffer -> daylight_savings_time) = (ts -> tm_isdst);
+ (buffer -> daylight_savings_time) = 0;
(buffer -> time_zone) = 0;
{
/* In gmtime() encoding, 0 is Sunday; in ours, it's Monday. */
}
time_t
-DEFUN (OS_encode_time ,(buffer), struct time_structure * buffer)
+DEFUN (OS_encode_time, (buffer), struct time_structure * buffer)
{
- time_t t;
- struct tm ts_s, * ts;
- ts = &ts_s;
- (ts -> tm_year) = ((buffer -> year) - 1900);
- (ts -> tm_mon) = ((buffer -> month) - 1);
- (ts -> tm_mday) = (buffer -> day);
- (ts -> tm_hour) = (buffer -> hour);
- (ts -> tm_min) = (buffer -> minute);
- (ts -> tm_sec) = (buffer -> second);
- (ts -> tm_isdst) = (buffer -> daylight_savings_time);
#ifdef HAVE_MKTIME
- STD_UINT_SYSTEM_CALL (syscall_mktime, t, (UX_mktime (ts)));
-#else
- error_system_call (ENOSYS, syscall_mktime);
-#endif
-#ifdef HAVE_TIMEZONE
+ time_t t = 0;
+ struct tm ts;
+ (ts . tm_year) = ((buffer -> year) - 1900);
+ (ts . tm_mon) = ((buffer -> month) - 1);
+ (ts . tm_mday) = (buffer -> day);
+ (ts . tm_hour) = (buffer -> hour);
+ (ts . tm_min) = (buffer -> minute);
+ (ts . tm_sec) = (buffer -> second);
+ (ts . tm_isdst) = (buffer -> daylight_savings_time);
+ STD_UINT_SYSTEM_CALL (syscall_mktime, t, (UX_mktime (&ts)));
+
/* mktime assumes its argument is local time, and converts it to
UTC; if the specified time zone is different, adjust the result. */
+#ifdef HAVE_TM_GMTOFF
+ {
+ if ((buffer -> time_zone) != INT_MAX)
+ {
+ long assumed_zone = (- (ts . TM_GMTOFF));
+ if ((ts . tm_isdst) > 0)
+ assumed_zone += 3600;
+ if ((buffer -> time_zone) != assumed_zone)
+ t = ((t - assumed_zone) + (buffer -> time_zone));
+ }
+ }
+#else /* not HAVE_TM_GMTOFF */
+#ifdef HAVE_TIMEZONE
if (((buffer -> time_zone) != INT_MAX)
- && ((buffer -> time_zone) != timezone))
- t = ((t - timezone) + (buffer -> time_zone));
-#endif
+ && ((buffer -> time_zone) != TIMEZONE))
+ t = ((t - TIMEZONE) + (buffer -> time_zone));
+#endif /* HAVE_TIMEZONE */
+#endif /* not HAVE_TM_GMTOFF */
+
return (t);
+
+#else /* not HAVE_MKTIME */
+ error_system_call (ENOSYS, syscall_mktime);
+ return (0);
+#endif /* not HAVE_MKTIME */
}
\f
#ifdef HAVE_TIMES
static clock_t initial_process_clock;
-#ifdef __linux
+#ifdef __linux__
/* Linux seems to record the time in an unusual way.
Time that Scheme programs spend computing do not seem to be recorded
as "user" time, but as "system" time. So return the sum of both times. */
#endif /* HAVE_TIMES */
#endif /* HAVE_GETTIMEOFDAY */
\f
-#ifdef HAVE_ITIMER
+#ifdef HAVE_SETITIMER
static void
DEFUN (set_timer, (which, first, interval),
set_timer (ITIMER_REAL, 0, 0);
}
-#else /* not HAVE_ITIMER */
+#else /* not HAVE_SETITIMER */
\f
static unsigned int alarm_interval;
UX_alarm (0);
}
-#endif /* HAVE_ITIMER */
+#endif /* HAVE_SETITIMER */
void
DEFUN_VOID (UX_initialize_environment)
{
initialize_process_clock ();
initialize_real_time_clock ();
-#ifndef HAVE_ITIMER
+#ifndef HAVE_SETITIMER
alarm_interval = 0;
#endif
}
/* -*-C-*-
-$Id: uxfile.c,v 1.9 1999/01/02 06:11:34 cph Exp $
+$Id: uxfile.c,v 1.10 2000/12/05 21:23:49 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
STD_UINT_SYSTEM_CALL
(syscall_open, fd, (UX_open (filename, oflag, MODE_REG)));
#ifdef SLAVE_PTY_P
- if ((SLAVE_PTY_P (filename)) && (! (SETUP_SLAVE_PTY (fd))))
+ if ((SLAVE_PTY_P (filename)) && (!UX_setup_slave_pty (fd)))
{
int xerrno = errno;
UX_close (fd);
DEFUN_OPEN_FILE (OS_open_output_file, (O_WRONLY | O_CREAT | O_TRUNC))
DEFUN_OPEN_FILE (OS_open_io_file, (O_RDWR | O_CREAT))
-#ifdef HAVE_APPEND
+#ifdef O_APPEND
DEFUN_OPEN_FILE (OS_open_append_file, (O_WRONLY | O_CREAT | O_APPEND))
/* -*-C-*-
-$Id: uxfs.c,v 1.19 2000/01/18 05:09:59 cph Exp $
+$Id: uxfs.c,v 1.20 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
#include "osio.h"
#ifdef HAVE_STATFS
-#include <sys/vfs.h>
-
-#ifdef __linux
+# ifdef HAVE_SYS_VFS_H
+ /* GNU/Linux */
+# include <sys/vfs.h>
+# else
+# ifdef HAVE_SYS_MOUNT_H
+ /* FreeBSD */
+# include <sys/param.h>
+# include <sys/mount.h>
+# endif
+# endif
+# ifdef __linux__
/* The following superblock magic constants are taken from the kernel
headers for Linux 2.0.33. We use these rather than reading the
header files, because the Linux kernel header files have
definitions that conflict with those of glibc2. These constants
are unlikely to be changed, so this ought to be safe. */
-
-#ifndef AFFS_SUPER_MAGIC
-#define AFFS_SUPER_MAGIC 0xadff
-#endif
-
-#ifndef COH_SUPER_MAGIC
-#define COH_SUPER_MAGIC 0x012FF7B7
-#endif
-
-#ifndef EXT_SUPER_MAGIC
-#define EXT_SUPER_MAGIC 0x137D
-#endif
-
-#ifndef EXT2_SUPER_MAGIC
-#define EXT2_SUPER_MAGIC 0xEF53
+# ifndef AFFS_SUPER_MAGIC
+# define AFFS_SUPER_MAGIC 0xadff
+# endif
+# ifndef COH_SUPER_MAGIC
+# define COH_SUPER_MAGIC 0x012FF7B7
+# endif
+# ifndef EXT_SUPER_MAGIC
+# define EXT_SUPER_MAGIC 0x137D
+# endif
+# ifndef EXT2_SUPER_MAGIC
+# define EXT2_SUPER_MAGIC 0xEF53
+# endif
+# ifndef HPFS_SUPER_MAGIC
+# define HPFS_SUPER_MAGIC 0xf995e849
+# endif
+# ifndef ISOFS_SUPER_MAGIC
+# define ISOFS_SUPER_MAGIC 0x9660
+# endif
+# ifndef MINIX_SUPER_MAGIC
+# define MINIX_SUPER_MAGIC 0x137F
+# endif
+# ifndef MINIX_SUPER_MAGIC2
+# define MINIX_SUPER_MAGIC2 0x138F
+# endif
+# ifndef MINIX2_SUPER_MAGIC
+# define MINIX2_SUPER_MAGIC 0x2468
+# endif
+# ifndef MINIX2_SUPER_MAGIC2
+# define MINIX2_SUPER_MAGIC2 0x2478
+# endif
+# ifndef MSDOS_SUPER_MAGIC
+# define MSDOS_SUPER_MAGIC 0x4d44
+# endif
+# ifndef NCP_SUPER_MAGIC
+# define NCP_SUPER_MAGIC 0x564c
+# endif
+# ifndef NFS_SUPER_MAGIC
+# define NFS_SUPER_MAGIC 0x6969
+# endif
+# ifndef NTFS_SUPER_MAGIC
+# define NTFS_SUPER_MAGIC 0x5346544E
+# endif
+# ifndef PROC_SUPER_MAGIC
+# define PROC_SUPER_MAGIC 0x9fa0
+# endif
+# ifndef SMB_SUPER_MAGIC
+# define SMB_SUPER_MAGIC 0x517B
+# endif
+# ifndef SYSV2_SUPER_MAGIC
+# define SYSV2_SUPER_MAGIC 0x012FF7B6
+# endif
+# ifndef SYSV4_SUPER_MAGIC
+# define SYSV4_SUPER_MAGIC 0x012FF7B5
+# endif
+# ifndef XENIX_SUPER_MAGIC
+# define XENIX_SUPER_MAGIC 0x012FF7B4
+# endif
+# ifndef _XIAFS_SUPER_MAGIC
+# define _XIAFS_SUPER_MAGIC 0x012FD16D
+# endif
+# endif
#endif
-#ifndef HPFS_SUPER_MAGIC
-#define HPFS_SUPER_MAGIC 0xf995e849
+#ifndef FILE_TOUCH_OPEN_TRIES
+# define FILE_TOUCH_OPEN_TRIES 5
#endif
-
-#ifndef ISOFS_SUPER_MAGIC
-#define ISOFS_SUPER_MAGIC 0x9660
-#endif
-
-#ifndef MINIX_SUPER_MAGIC
-#define MINIX_SUPER_MAGIC 0x137F
-#endif
-
-#ifndef MINIX_SUPER_MAGIC2
-#define MINIX_SUPER_MAGIC2 0x138F
-#endif
-
-#ifndef MINIX2_SUPER_MAGIC
-#define MINIX2_SUPER_MAGIC 0x2468
-#endif
-
-#ifndef MINIX2_SUPER_MAGIC2
-#define MINIX2_SUPER_MAGIC2 0x2478
-#endif
-
-#ifndef MSDOS_SUPER_MAGIC
-#define MSDOS_SUPER_MAGIC 0x4d44
-#endif
-
-#ifndef NCP_SUPER_MAGIC
-#define NCP_SUPER_MAGIC 0x564c
-#endif
-
-#ifndef NFS_SUPER_MAGIC
-#define NFS_SUPER_MAGIC 0x6969
-#endif
-
-#ifndef NTFS_SUPER_MAGIC
-#define NTFS_SUPER_MAGIC 0x5346544E
-#endif
-
-#ifndef PROC_SUPER_MAGIC
-#define PROC_SUPER_MAGIC 0x9fa0
-#endif
-
-#ifndef SMB_SUPER_MAGIC
-#define SMB_SUPER_MAGIC 0x517B
-#endif
-
-#ifndef SYSV2_SUPER_MAGIC
-#define SYSV2_SUPER_MAGIC 0x012FF7B6
-#endif
-
-#ifndef SYSV4_SUPER_MAGIC
-#define SYSV4_SUPER_MAGIC 0x012FF7B5
-#endif
-
-#ifndef XENIX_SUPER_MAGIC
-#define XENIX_SUPER_MAGIC 0x012FF7B4
-#endif
-
-#ifndef _XIAFS_SUPER_MAGIC
-#define _XIAFS_SUPER_MAGIC 0x012FD16D
-#endif
-
-#endif /* __linux */
-
-#endif /* HAVE_STATFS */
\f
int
DEFUN (UX_read_file_status, (filename, s),
struct stat s;
if (!UX_read_file_status (name, (&s)))
return (file_doesnt_exist);
-#ifdef HAVE_SYMBOLIC_LINKS
+#ifdef HAVE_SYMLINK
if (((s . st_mode) & S_IFMT) == S_IFLNK)
{
if (UX_read_file_status_indirect (name, (&s)))
struct stat s;
if (!UX_read_file_status (name, (&s)))
return (file_doesnt_exist);
-#ifdef HAVE_SYMBOLIC_LINKS
+#ifdef HAVE_SYMLINK
if (((s . st_mode) & S_IFMT) == S_IFLNK)
return (file_is_link);
#endif
error_system_call (errno, syscall_statfs);
}
-#ifdef __linux
+#ifdef __linux__
switch (s . f_type)
{
case COH_SUPER_MAGIC: return ("coherent");
case XENIX_SUPER_MAGIC: return ("xenix");
case _XIAFS_SUPER_MAGIC: return ("xiafs");
}
-#endif /* __linux */
+#endif /* __linux__ */
-#ifdef _HPUX
+#ifdef __HPUX__
switch ((s . f_fsid) [1])
{
case MOUNT_UFS: return ("ufs");
case MOUNT_NFS: return ("nfs");
case MOUNT_CDFS: return ("iso9660");
}
-#endif /* _HPUX */
+#endif /* __HPUX__ */
#endif /* HAVE_STATFS */
return (0);
CONST char *
DEFUN (OS_file_soft_link_p, (name), CONST char * name)
{
-#ifdef HAVE_SYMBOLIC_LINKS
+#ifdef HAVE_SYMLINK
struct stat s;
if (! ((UX_read_file_status (name, (&s)))
&& (((s . st_mode) & S_IFMT) == S_IFLNK)))
struct stat s;
if ((UX_read_file_status (name, (&s)))
&& ((((s . st_mode) & S_IFMT) == S_IFREG)
-#ifdef HAVE_SYMBOLIC_LINKS
+#ifdef HAVE_SYMLINK
|| (((s . st_mode) & S_IFMT) == S_IFLNK)
#endif
))
CONST char * from_name AND
CONST char * to_name)
{
-#ifdef HAVE_SYMBOLIC_LINKS
+#ifdef HAVE_SYMLINK
STD_VOID_SYSTEM_CALL (syscall_symlink, (UX_symlink (from_name, to_name)));
#else
error_unimplemented_primitive ();
STD_VOID_SYSTEM_CALL (syscall_rmdir, (UX_rmdir (name)));
}
\f
-#if defined(HAVE_DIRENT) || defined(HAVE_DIR)
+static void EXFUN (protect_fd, (int fd));
+
+int
+DEFUN (OS_file_touch, (filename), CONST char * filename)
+{
+ int fd;
+ transaction_begin ();
+ {
+ unsigned int count = 0;
+ while (1)
+ {
+ count += 1;
+ /* Use O_EXCL to prevent overwriting existing file. */
+ fd = (UX_open (filename, (O_RDWR | O_CREAT | O_EXCL), MODE_REG));
+ if (fd >= 0)
+ {
+ protect_fd (fd);
+ transaction_commit ();
+ return (1);
+ }
+ if (errno == EEXIST)
+ {
+ fd = (UX_open (filename, O_RDWR, MODE_REG));
+ if (fd >= 0)
+ {
+ protect_fd (fd);
+ break;
+ }
+ else if ((errno == ENOENT)
+#ifdef ESTALE
+ || (errno == ESTALE)
+#endif
+ )
+ continue;
+ }
+ if (count >= FILE_TOUCH_OPEN_TRIES)
+ error_system_call (errno, syscall_open);
+ }
+ }
+ {
+ struct stat file_status;
+ STD_VOID_SYSTEM_CALL (syscall_fstat, (UX_fstat (fd, (&file_status))));
+ if (((file_status . st_mode) & S_IFMT) != S_IFREG)
+ error_system_call (errno, syscall_open);
+ /* CASE 3: file length of 0 needs special treatment. */
+ if ((file_status . st_size) == 0)
+ {
+ char buf [1];
+ (buf[0]) = '\0';
+ STD_VOID_SYSTEM_CALL (syscall_write, (UX_write (fd, buf, 1)));
+#ifdef HAVE_FTRUNCATE
+ STD_VOID_SYSTEM_CALL (syscall_ftruncate, (UX_ftruncate (fd, 0)));
+ transaction_commit ();
+#else
+ transaction_commit ();
+ fd = (UX_open (filename, (O_WRONLY | O_TRUNC), MODE_REG));
+ if (fd >= 0)
+ STD_VOID_SYSTEM_CALL (syscall_close, (UX_close (fd)));
+#endif
+ return (0);
+ }
+ }
+ /* CASE 4: read, then write back the first byte in the file. */
+ {
+ char buf [1];
+ int scr;
+ STD_UINT_SYSTEM_CALL (syscall_read, scr, (UX_read (fd, buf, 1)));
+ if (scr > 0)
+ {
+ STD_VOID_SYSTEM_CALL (syscall_lseek, (UX_lseek (fd, 0, SEEK_SET)));
+ STD_VOID_SYSTEM_CALL (syscall_write, (UX_write (fd, buf, 1)));
+ }
+ }
+ transaction_commit ();
+ return (0);
+}
+static void
+DEFUN (protect_fd_close, (ap), PTR ap)
+{
+ UX_close (* ((int *) ap));
+}
+
+static void
+DEFUN (protect_fd, (fd), int fd)
+{
+ int * p = (dstack_alloc (sizeof (int)));
+ (*p) = fd;
+ transaction_record_action (tat_always, protect_fd_close, p);
+}
+\f
static DIR ** directory_pointers;
static unsigned int n_directory_pointers;
return (allocate_directory_pointer (pointer));
}
-#ifndef HAVE_DIRENT
-#define dirent direct
-#endif
-
CONST char *
DEFUN (OS_directory_read, (index), unsigned int index)
{
closedir (REFERENCE_DIRECTORY (index));
DEALLOCATE_DIRECTORY (index);
}
-\f
-#else /* not HAVE_DIRENT nor HAVE_DIR */
-
-void
-DEFUN_VOID (UX_initialize_directory_reader)
-{
- return;
-}
-
-int
-DEFUN (OS_directory_valid_p, (index), long index)
-{
- return (0);
-}
-
-unsigned int
-DEFUN (OS_directory_open, (name), CONST char * name)
-{
- error_unimplemented_primitive ();
- /*NOTREACHED*/
-}
-
-#ifndef HAVE_DIRENT
-#define dirent direct
-#endif
-
-CONST char *
-DEFUN (OS_directory_read, (index), unsigned int index)
-{
- error_unimplemented_primitive ();
- /*NOTREACHED*/
-}
-
-CONST char *
-DEFUN (OS_directory_read_matching, (index, prefix),
- unsigned int index AND
- CONST char * prefix)
-{
- error_unimplemented_primitive ();
- /*NOTREACHED*/
-}
-
-void
-DEFUN (OS_directory_close, (index), unsigned int index)
-{
- error_unimplemented_primitive ();
- /*NOTREACHED*/
-}
-
-#endif /* HAVE_DIRENT */
/* -*-C-*-
-$Id: uxio.c,v 1.44 2000/08/18 15:51:41 cph Exp $
+$Id: uxio.c,v 1.45 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
size_t OS_channel_table_size;
struct channel * channel_table;
-#ifdef HAVE_POLL
-
-#include <poll.h>
-
-#else /* not HAVE_POLL */
-
-#ifdef FD_SET
-#define SELECT_TYPE fd_set
-#else
-#define SELECT_TYPE int
-#define FD_SETSIZE ((sizeof (int)) * CHAR_BIT)
-#define FD_SET(n, p) ((*(p)) |= (1 << (n)))
-#define FD_CLR(n, p) ((*(p)) &= ~(1 << (n)))
-#define FD_ISSET(n, p) (((*(p)) & (1 << (n))) != 0)
-#define FD_ZERO(p) ((*(p)) = 0)
-#endif
-
+#ifndef HAVE_POLL
static SELECT_TYPE input_descriptors;
#ifdef HAVE_SELECT
static struct timeval zero_timeout;
#endif
-
-#endif /* not HAVE_POLL */
+#endif
static void
DEFUN_VOID (UX_channel_close_all)
#endif /* FCNTL_NONBLOCK */
\f
-/* select(2) system call */
-
-#ifndef HAVE_POLL
+#ifdef HAVE_POLL
-#if (defined(_HPUX) && (_HPUX_VERSION >= 80)) || defined(_SUNOS4) || defined(_AIX)
-#define SELECT_DECLARED
-#endif
+/* poll(2) */
-#ifdef HAVE_SELECT
CONST int OS_have_select_p = 1;
-#ifndef SELECT_DECLARED
-extern int EXFUN (UX_select,
- (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
- struct timeval *));
-#endif /* not SELECT_DECLARED */
-#else /* not HAVE_SELECT */
-CONST int OS_have_select_p = 0;
-#endif /* not HAVE_SELECT */
unsigned int
DEFUN_VOID (UX_select_registry_size)
{
- return (sizeof (SELECT_TYPE));
+ return ((sizeof (struct pollfd)) * OS_channel_table_size);
}
unsigned int
DEFUN_VOID (UX_select_registry_lub)
{
- return (FD_SETSIZE);
+ return (OS_channel_table_size);
}
void
DEFUN (UX_select_registry_clear_all, (fds), PTR fds)
{
- FD_ZERO ((SELECT_TYPE *) fds);
+ struct pollfd * scan = fds;
+ struct pollfd * end = (scan + OS_channel_table_size);
+ for (; (scan < end); scan += 1)
+ {
+ (scan -> fd) = (-1);
+ (scan -> events) = 0;
+ }
}
void
DEFUN (UX_select_registry_set, (fds, fd), PTR fds AND unsigned int fd)
{
- FD_SET (fd, ((SELECT_TYPE *) fds));
+ struct pollfd * scan = fds;
+ struct pollfd * end = (scan + OS_channel_table_size);
+ for (; (scan < end); scan += 1)
+ if (((scan -> fd) == (-1)) || ((scan -> fd) == fd))
+ {
+ (scan -> fd) = fd;
+ (scan -> events) = POLLIN;
+ break;
+ }
}
void
DEFUN (UX_select_registry_clear, (fds, fd), PTR fds AND unsigned int fd)
{
- FD_CLR (fd, ((SELECT_TYPE *) fds));
+ struct pollfd * scan = fds;
+ struct pollfd * end = (scan + OS_channel_table_size);
+ for (; (scan < end); scan += 1)
+ if ((scan -> fd) == fd)
+ {
+ /* Shift any subsequent entries down. */
+ for (; (((scan + 1) < end) && ((scan -> fd) != (-1))); scan += 1)
+ (*scan) = (* (scan + 1));
+ (scan -> fd) = (-1);
+ (scan -> events) = 0;
+ return;
+ }
}
int
DEFUN (UX_select_registry_is_set, (fds, fd), PTR fds AND unsigned int fd)
{
- return (FD_ISSET (fd, ((SELECT_TYPE *) fds)));
+ struct pollfd * scan = fds;
+ struct pollfd * end = (scan + OS_channel_table_size);
+ for (; (scan < end); scan += 1)
+ if ((scan -> fd) == fd)
+ return (1);
+ return (0);
}
-\f
+
+static unsigned int
+count_select_registry_entries (struct pollfd * pfds)
+{
+ struct pollfd * end = (pfds + OS_channel_table_size);
+ struct pollfd * scan;
+ for (scan = pfds; (scan < end); scan += 1)
+ if ((scan -> fd) == (-1))
+ break;
+ return (scan - pfds);
+}
+
enum select_input
DEFUN (UX_select_registry_test, (input_fds, blockp, output_fds, output_nfds),
PTR input_fds AND
unsigned int * output_fds AND
unsigned int * output_nfds)
{
-#ifdef HAVE_SELECT
+ struct pollfd * pfds = input_fds;
+ unsigned int n_pfds = (count_select_registry_entries (pfds));
while (1)
{
- SELECT_TYPE readable;
- int nfds;
-
- readable = (* ((SELECT_TYPE *) input_fds));
- INTERRUPTABLE_EXTENT
- (nfds,
- ((OS_process_any_status_change ())
- ? ((errno = EINTR), (-1))
- : (UX_select (FD_SETSIZE,
- (&readable),
- ((SELECT_TYPE *) 0),
- ((SELECT_TYPE *) 0),
- (blockp
- ? ((struct timeval *) 0)
- : (&zero_timeout))))));
+ int nfds = (poll (pfds, n_pfds, (blockp ? INFTIM : 0)));
if (nfds > 0)
{
- unsigned int i = 0;
if (output_nfds != 0)
(*output_nfds) = nfds;
if (output_fds != 0)
- while (1)
- {
- if (FD_ISSET (i, (&readable)))
+ {
+ unsigned int i;
+ for (i = 0; (i < n_pfds); i += 1)
+ if ((((pfds [i]) . fd) != (-1))
+ && ((((pfds [i]) . revents) & POLLIN) != 0))
{
- (*output_fds++) = i;
+ (*output_fds++) = ((pfds [i]) . fd);
if ((--nfds) == 0)
break;
}
- i += 1;
- }
+ }
return (select_input_argument);
}
else if (nfds == 0)
if (!blockp)
return (select_input_none);
}
- else if (errno != EINTR)
+ else if (! ((errno == EINTR) || (errno == EAGAIN)))
error_system_call (errno, syscall_select);
else if (OS_process_any_status_change ())
return (select_input_process_status);
if (pending_interrupts_p ())
return (select_input_interrupt);
}
-#else
- error_system_call (ENOSYS, syscall_select);
- return (select_input_argument);
-#endif
}
enum select_input
unsigned int fd AND
int blockp)
{
-#ifdef HAVE_SELECT
- SELECT_TYPE readable;
+ struct pollfd pfds [1];
+ int nfds;
- FD_ZERO (&readable);
- FD_SET (fd, (&readable));
- return (UX_select_registry_test ((&readable), blockp, 0, 0));
-#else
- error_system_call (ENOSYS, syscall_select);
- return (select_input_argument);
-#endif
+ ((pfds [0]) . fd) = fd;
+ ((pfds [0]) . events) = POLLIN;
+ while (1)
+ {
+ nfds = (poll (pfds, 1, (blockp ? INFTIM : 0)));
+ if (nfds > 0)
+ return (select_input_argument);
+ else if (nfds == 0)
+ {
+ if (!blockp)
+ return (select_input_none);
+ }
+ else if (errno != EINTR)
+ error_system_call (errno, syscall_select);
+ else if (OS_process_any_status_change ())
+ return (select_input_process_status);
+ if (pending_interrupts_p ())
+ return (select_input_interrupt);
+ }
}
-\f
+
enum select_input
DEFUN (UX_select_input, (fd, blockp), int fd AND int blockp)
{
- SELECT_TYPE readable;
- unsigned int fds [FD_SETSIZE];
- unsigned int nfds;
-
- readable = input_descriptors;
- FD_SET (fd, (&readable));
- {
- enum select_input s =
- (UX_select_registry_test ((&readable), blockp, fds, (&nfds)));
- if (s != select_input_argument)
- return (s);
- }
- {
- unsigned int * scan = fds;
- unsigned int * end = (scan + nfds);
- while (scan < end)
- if ((*scan++) == fd)
- return (select_input_argument);
- }
- return (select_input_other);
+ return (UX_select_descriptor (fd, blockp));
}
+
+#else /* not HAVE_POLL */
\f
-#else /* HAVE_POLL */
+/* select(2) */
+#ifdef HAVE_SELECT
CONST int OS_have_select_p = 1;
+#else
+CONST int OS_have_select_p = 0;
+#endif
unsigned int
DEFUN_VOID (UX_select_registry_size)
{
- return ((sizeof (struct pollfd)) * OS_channel_table_size);
+ return (sizeof (SELECT_TYPE));
}
unsigned int
DEFUN_VOID (UX_select_registry_lub)
{
- return (OS_channel_table_size);
+ return (FD_SETSIZE);
}
void
DEFUN (UX_select_registry_clear_all, (fds), PTR fds)
{
- struct pollfd * pfds = fds;
- unsigned int i;
- for (i = 0; (i < OS_channel_table_size); i += 1)
- {
- ((pfds [i]) . fd) = (-1);
- ((pfds [i]) . events) = 0;
- }
+ FD_ZERO ((SELECT_TYPE *) fds);
}
void
DEFUN (UX_select_registry_set, (fds, fd), PTR fds AND unsigned int fd)
{
- struct pollfd * pfds = fds;
- unsigned int i;
- for (i = 0; (i < OS_channel_table_size); i += 1)
- if ((((pfds [i]) . fd) == (-1)) || (((pfds [i]) . fd) == fd))
- {
- ((pfds [i]) . fd) = fd;
- ((pfds [i]) . events) = POLLIN;
- break;
- }
+ FD_SET (fd, ((SELECT_TYPE *) fds));
}
void
DEFUN (UX_select_registry_clear, (fds, fd), PTR fds AND unsigned int fd)
{
- struct pollfd * pfds = fds;
- unsigned int i;
- for (i = 0; (i < OS_channel_table_size); i += 1)
- if (((pfds [i]) . fd) == fd)
- {
- ((pfds [i]) . fd) = (-1);
- ((pfds [i]) . events) = 0;
- break;
- }
+ FD_CLR (fd, ((SELECT_TYPE *) fds));
}
int
DEFUN (UX_select_registry_is_set, (fds, fd), PTR fds AND unsigned int fd)
{
- struct pollfd * pfds = fds;
- unsigned int i;
- for (i = 0; (i < OS_channel_table_size); i += 1)
- if (((pfds [i]) . fd) == fd)
- return (1);
- return (0);
+ return (FD_ISSET (fd, ((SELECT_TYPE *) fds)));
}
-\f
+
enum select_input
DEFUN (UX_select_registry_test, (input_fds, blockp, output_fds, output_nfds),
PTR input_fds AND
unsigned int * output_fds AND
unsigned int * output_nfds)
{
- struct pollfd * pfds = input_fds;
+#ifdef HAVE_SELECT
while (1)
{
- int nfds = (poll (pfds, OS_channel_table_size, (blockp ? INFTIM : 0)));
+ SELECT_TYPE readable;
+ int nfds;
+
+ readable = (* ((SELECT_TYPE *) input_fds));
+ INTERRUPTABLE_EXTENT
+ (nfds,
+ ((OS_process_any_status_change ())
+ ? ((errno = EINTR), (-1))
+ : (UX_select (FD_SETSIZE,
+ (&readable),
+ ((SELECT_TYPE *) 0),
+ ((SELECT_TYPE *) 0),
+ (blockp
+ ? ((struct timeval *) 0)
+ : (&zero_timeout))))));
if (nfds > 0)
{
+ unsigned int i = 0;
if (output_nfds != 0)
(*output_nfds) = nfds;
if (output_fds != 0)
- {
- unsigned int i;
- for (i = 0; (i < OS_channel_table_size); i += 1)
- if ((((pfds [i]) . fd) != (-1))
- && ((((pfds [i]) . revents) & POLLIN) != 0))
+ while (1)
+ {
+ if (FD_ISSET (i, (&readable)))
{
- (*output_fds++) = ((pfds [i]) . fd);
+ (*output_fds++) = i;
if ((--nfds) == 0)
break;
}
- }
+ i += 1;
+ }
return (select_input_argument);
}
else if (nfds == 0)
if (!blockp)
return (select_input_none);
}
- else if (! ((errno == EINTR) || (errno == EAGAIN)))
+ else if (errno != EINTR)
error_system_call (errno, syscall_select);
else if (OS_process_any_status_change ())
return (select_input_process_status);
if (pending_interrupts_p ())
return (select_input_interrupt);
}
+#else
+ error_system_call (ENOSYS, syscall_select);
+ return (select_input_argument);
+#endif
}
enum select_input
unsigned int fd AND
int blockp)
{
- struct pollfd pfds [1];
- int nfds;
+#ifdef HAVE_SELECT
+ SELECT_TYPE readable;
- ((pfds [0]) . fd) = fd;
- ((pfds [0]) . events) = POLLIN;
- while (1)
- {
- nfds = (poll (pfds, 1, (blockp ? INFTIM : 0)));
- if (nfds > 0)
- return (select_input_argument);
- else if (nfds == 0)
- {
- if (!blockp)
- return (select_input_none);
- }
- else if (errno != EINTR)
- error_system_call (errno, syscall_select);
- else if (OS_process_any_status_change ())
- return (select_input_process_status);
- if (pending_interrupts_p ())
- return (select_input_interrupt);
- }
+ FD_ZERO (&readable);
+ FD_SET (fd, (&readable));
+ return (UX_select_registry_test ((&readable), blockp, 0, 0));
+#else
+ error_system_call (ENOSYS, syscall_select);
+ return (select_input_argument);
+#endif
}
enum select_input
DEFUN (UX_select_input, (fd, blockp), int fd AND int blockp)
{
- return (UX_select_descriptor (fd, blockp));
+ SELECT_TYPE readable;
+ unsigned int fds [FD_SETSIZE];
+ unsigned int nfds;
+
+ readable = input_descriptors;
+ FD_SET (fd, (&readable));
+ {
+ enum select_input s =
+ (UX_select_registry_test ((&readable), blockp, fds, (&nfds)));
+ if (s != select_input_argument)
+ return (s);
+ }
+ {
+ unsigned int * scan = fds;
+ unsigned int * end = (scan + nfds);
+ while (scan < end)
+ if ((*scan++) == fd)
+ return (select_input_argument);
+ }
+ return (select_input_other);
}
-#endif /* HAVE_POLL */
+#endif /* not HAVE_POLL */
/* -*-C-*-
-$Id: uxproc.c,v 1.25 2000/02/01 01:47:25 cph Exp $
+$Id: uxproc.c,v 1.26 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
#include "error: can't hack subprocess I/O without dup2() or equivalent"
#endif
-extern char ** environ;
-extern void EXFUN
- ((*subprocess_death_hook), (pid_t pid, wait_status_t * status));
+extern void EXFUN ((*subprocess_death_hook), (pid_t pid, int * status));
extern void EXFUN ((*stop_signal_hook), (int signo));
extern void EXFUN (stop_signal_default, (int signo));
extern int EXFUN (OS_ctty_fd, (void));
extern void EXFUN (UX_initialize_child_signals, (void));
-static void EXFUN (subprocess_death, (pid_t pid, wait_status_t * status));
+static void EXFUN (subprocess_death, (pid_t pid, int * status));
static void EXFUN (stop_signal_handler, (int signo));
static void EXFUN (give_terminal_to, (Tprocess process));
static void EXFUN (get_terminal_back, (void));
#else /* not HAVE_POSIX_SIGNALS */
-#ifdef HAVE_SYSV3_SIGNALS
+#ifdef HAVE_SIGHOLD
static void
DEFUN (release_sigchld, (environment), PTR environment)
transaction_record_action (tat_always, release_sigchld, 0);
}
-#else /* not HAVE_SYSV3_SIGNALS */
+#else /* not HAVE_SIGHOLD */
#define block_sigchld()
-#endif /* not HAVE_SYSV3_SIGNALS */
+#endif /* not HAVE_SIGHOLD */
#define block_jc_signals block_sigchld
#define grab_signal_mask()
case process_status_running:
UX_kill ((PROCESS_ID (process)), SIGKILL);
break;
+ default:
+ break;
}
OS_process_deallocate (process);
}
channel_err_type, channel_err),
CONST char * filename AND
CONST char ** argv AND
- CONST char ** envp AND
+ CONST char ** VOLATILE envp AND
CONST char * working_directory AND
enum process_ctty_type ctty_type AND
char * ctty_name AND
{
pid_t child_pid;
Tprocess child;
- enum process_jc_status child_jc_status;
+ VOLATILE enum process_jc_status child_jc_status = process_jc_status_no_ctty;
if (envp == 0)
envp = ((CONST char **) environ);
int fd = (UX_open (ctty_name, O_RDWR, 0));
if ((fd < 0)
#ifdef SLAVE_PTY_P
- || ((SLAVE_PTY_P (ctty_name)) && (! (SETUP_SLAVE_PTY (fd))))
+ || ((SLAVE_PTY_P (ctty_name)) && (!UX_setup_slave_pty (fd)))
#endif
- || (! (isatty (fd)))
+ || (!isatty (fd))
#ifdef TIOCSCTTY
|| ((UX_ioctl (fd, TIOCSCTTY, 0)) < 0)
#endif
}
static void
-DEFUN (subprocess_death, (pid, status), pid_t pid AND wait_status_t * status)
+DEFUN (subprocess_death, (pid, status), pid_t pid AND int * status)
{
Tprocess process = (find_process (pid));
if (process != NO_PROCESS)
/* Set up the terminal at the other end of a pseudo-terminal that we
will be controlling an inferior through. */
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
#ifndef IUCLC
/* POSIX.1 doesn't require (or even mention) these symbols, but we
return (UX_tcsetattr (fd, TCSADRAIN, (&s)));
}
-#else /* not HAVE_TERMIOS */
+#else /* not HAVE_TERMIOS_H */
-#ifdef HAVE_TERMIO
+#ifdef HAVE_TERMIO_H
static int
DEFUN (child_setup_tty, (fd), int fd)
return (ioctl (fd, TCSETAW, (&s)));
}
-#else /* not HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
static int
DEFUN (child_setup_tty, (fd), int fd)
return (ioctl (fd, TIOCSETN, (&s)));
}
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIO */
-#endif /* HAVE_TERMIOS */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIO_H */
+#endif /* HAVE_TERMIOS_H */
/* -*-C-*-
-$Id: uxsig.c,v 1.34 2000/01/18 05:10:22 cph Exp $
+$Id: uxsig.c,v 1.35 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
}
#else /* not HAVE_POSIX_SIGNALS */
-#ifdef HAVE_SYSV3_SIGNALS
+#ifdef HAVE_SIGHOLD
static Tsignal_handler
DEFUN (current_handler, (signo), int signo)
return (result);
}
-#else /* not HAVE_SYSV3_SIGNALS */
+#else /* not HAVE_SIGHOLD */
static Tsignal_handler
DEFUN (current_handler, (signo), int signo)
return (result);
}
-#endif /* HAVE_SYSV3_SIGNALS */
+#endif /* HAVE_SIGHOLD */
#endif /* HAVE_POSIX_SIGNALS */
#ifdef NEED_HANDLER_TRANSACTION
return ((CONST char *) buffer);
}
\f
-#ifdef _HPUX
-
-#define OS_SPECIFIC_SIGNALS() \
-{ \
- defsignal (SIGPWR, "SIGPWR", dfl_ignore, 0); \
- defsignal (SIGWINDOW, "SIGWINDOW", dfl_ignore, 0); \
- defsignal (SIGLOST, "SIGLOST", dfl_terminate, 0); \
-}
-
-#else /* not _HPUX */
-#ifdef _BSD
-
-#define OS_SPECIFIC_SIGNALS() \
-{ \
- defsignal (SIGXCPU, "SIGXCPU", dfl_terminate, 0); \
- defsignal (SIGXFSZ, "SIGXFSZ", dfl_terminate, 0); \
- defsignal (SIGWINCH, "SIGWINCH", dfl_ignore, 0); \
-}
-
-#endif /* _BSD */
-#endif /* _HPUX */
-
#if (SIGABRT == SIGIOT)
-#undef SIGABRT
-#define SIGABRT 0
+# undef SIGABRT
+# define SIGABRT 0
#endif
static void
defsignal (SIGCHLD, "SIGCHLD", dfl_ignore, 0);
defsignal (SIGTTIN, "SIGTTIN", dfl_stop, 0);
defsignal (SIGTTOU, "SIGTTOU", dfl_stop, 0);
-#ifdef OS_SPECIFIC_SIGNALS
- OS_SPECIFIC_SIGNALS ();
-#endif
+ defsignal (SIGLOST, "SIGLOST", dfl_terminate, 0);
+ defsignal (SIGXCPU, "SIGXCPU", dfl_terminate, 0);
+ defsignal (SIGXFSZ, "SIGXFSZ", dfl_terminate, 0);
+ defsignal (SIGPWR, "SIGPWR", dfl_ignore, 0);
+ defsignal (SIGWINDOW, "SIGWINDOW", dfl_ignore, 0);
+ defsignal (SIGWINCH, "SIGWINCH", dfl_ignore, 0);
}
\f
#define CONTROL_B_INTERRUPT_CHAR 'B'
by conditionalizing the code inside the handler, but the Sun
compiler won't accept this conditionalization. */
-#ifdef HAVE_ITIMER
+#ifdef HAVE_SETITIMER
static
DEFUN_STD_HANDLER (sighnd_timer,
request_timer_interrupt ();
})
-#else /* not HAVE_ITIMER */
+#else /* not HAVE_SETITIMER */
static
DEFUN_STD_HANDLER (sighnd_timer,
request_timer_interrupt ();
})
-#endif /* not HAVE_ITIMER */
+#endif /* not HAVE_SETITIMER */
static
DEFUN_STD_HANDLER (sighnd_save_then_terminate,
/* On systems with waitpid() (i.e. those that support WNOHANG) we must
loop until there are no more processes, because some of those
systems may deliver only one SIGCHLD when more than one child
- terminates. Systems without waitpid() (e.g. _SYSV) typically
+ terminates. Systems without waitpid() (e.g. System V) typically
provide queuing of SIGCHLD such that one SIGCHLD is delivered for
every child that terminates. Systems that provide neither
waitpid() nor queuing are so losing that we can't win, in which
case we just hope that child terminations don't happen too close to
one another to cause problems. */
-void EXFUN ((*subprocess_death_hook), (pid_t pid, wait_status_t * status));
+void EXFUN ((*subprocess_death_hook), (pid_t pid, int * status));
#ifdef HAVE_WAITPID
#define WAITPID(status) (UX_waitpid ((-1), (status), (WNOHANG | WUNTRACED)))
{
while (1)
{
- wait_status_t status;
+ int status;
pid_t pid = (WAITPID (&status));
if (pid <= 0)
break;
UX_sigprocmask (SIG_SETMASK, (&empty_mask), 0);
}
#else
-#ifdef HAVE_SYSV3_SIGNALS
+#ifdef HAVE_SIGHOLD
/* We could do something more here, but it is hard to enumerate all
the possible signals. Instead, just release SIGCHLD, which we
know was held before the child was spawned. */
#endif /* vax */
\f
-#if defined(sonyrisc) && defined(_SYSV4)
+#if defined(sonyrisc) && defined(HAVE_GRANTPT)
/* Sony NEWS-OS 5.0.2 has a nasty bug because `sigaction' maintains a
table which contains the signal handlers, and passes
`sigaction_handler' to the kernel in place of any handler's
sigrelse (SIGCHLD);
}
-#endif /* sonyrisc && _SYSV4 */
+#endif /* sonyrisc and HAVE_GRANTPT */
/* -*-C-*-
-$Id: uxsig.h,v 1.5 1999/01/02 06:11:34 cph Exp $
+$Id: uxsig.h,v 1.6 2000/12/05 21:23:49 cph Exp $
-Copyright (c) 1993-1999 Massachusetts Institute of Technology
+Copyright (c) 1993-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#define SCM_UXSIG_H
#ifdef HAVE_POSIX_SIGNALS
- extern void EXFUN (INSTALL_HANDLER, (int, Tsignal_handler));
-
-#else /* not HAVE_POSIX_SIGNALS */
-#ifdef HAVE_SYSV3_SIGNALS
-# define INSTALL_HANDLER UX_sigset
-# define NEED_HANDLER_TRANSACTION
-# define ENTER_HANDLER(signo)
-# define ABORT_HANDLER(signo, handler) UX_sigrelse (signo)
-# define EXIT_HANDLER(signo, handler)
-
-#else /* not HAVE_SYSV3_SIGNALS */
-# define INSTALL_HANDLER UX_signal
-# define NEED_HANDLER_TRANSACTION
-# define ENTER_HANDLER(signo) UX_signal ((signo), SIG_IGN)
-# define ABORT_HANDLER UX_signal
-# define EXIT_HANDLER UX_signal
-
-#endif /* HAVE_SYSV3_SIGNALS */
-#endif /* HAVE_POSIX_SIGNALS */
+ extern void EXFUN (INSTALL_HANDLER, (int, Tsignal_handler));
+#else
+# ifdef HAVE_SIGHOLD
+# define INSTALL_HANDLER UX_sigset
+# define NEED_HANDLER_TRANSACTION
+# define ENTER_HANDLER(signo)
+# define ABORT_HANDLER(signo, handler) UX_sigrelse (signo)
+# define EXIT_HANDLER(signo, handler)
+# else
+# define INSTALL_HANDLER UX_signal
+# define NEED_HANDLER_TRANSACTION
+# define ENTER_HANDLER(signo) UX_signal ((signo), SIG_IGN)
+# define ABORT_HANDLER UX_signal
+# define EXIT_HANDLER UX_signal
+# endif
+#endif
\f
#ifndef NEED_HANDLER_TRANSACTION
/* -*-C-*-
-$Id: uxsock.c,v 1.25 2000/10/17 17:16:17 cph Exp $
+$Id: uxsock.c,v 1.26 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
#ifdef HAVE_SOCKETS
-#include <sys/socket.h>
-#include <netinet/in.h>
-#include <netdb.h>
-#ifdef HAVE_UNIX_SOCKETS
-#include <sys/un.h>
-#endif
-
-#ifdef HAVE_SELECT
-#include <sys/time.h>
-#include <sys/types.h>
-#else
-#ifdef HAVE_POLL
-#include <sys/poll.h>
-#endif
-#endif
-
#include "uxsock.h"
#include "uxio.h"
#include "prims.h"
#include "limits.h"
-#if 0
-extern struct servent * EXFUN (getservbyname, (CONST char *, CONST char *));
-extern struct hostent * EXFUN (gethostbyname, (CONST char *));
-extern char * EXFUN (strncpy, (char *, CONST char *, size_t));
-#endif
-
-#ifdef __linux
-#define HAVE_SOCKLEN_T
-#endif
-#ifndef HAVE_SOCKLEN_T
-typedef int socklen_t;
-#endif
-
static void do_connect (int, struct sockaddr *, socklen_t);
\f
Tchannel
/* Yuk; lots of hair because connect can't be restarted.
Instead, we must wait for the connection to finish, then
examine the SO_ERROR socket option. */
+#ifdef HAVE_POLL
+ {
+ struct pollfd fds;
+ int nfds;
+
+ (fds . fd) = s;
+ (fds . events) = (POLLIN | POLLOUT);
+ nfds = (poll ((&fds), 1, 0));
+ if ((nfds > 0) && (((fds . revents) & (POLLIN | POLLOUT)) != 0))
+ break;
+ if ((nfds < 0) && (errno != EINTR))
+ error_system_call (errno, syscall_select);
+ }
+#else /* not HAVE_POLL */
#ifdef HAVE_SELECT
{
fd_set readers;
error_system_call (errno, syscall_select);
}
#else /* not HAVE_SELECT */
-#ifdef HAVE_POLL
- {
- struct pollfd fds;
- int nfds;
-
- (fds . fd) = s;
- (fds . events) = (POLLIN | POLLOUT);
- nfds = (poll (fds, 1, 0));
- if ((nfds > 0) && (((fds . revents) & (POLLIN | POLLOUT)) != 0))
- break;
- if ((nfds < 0) && (errno != EINTR))
- error_system_call (errno, syscall_select);
- }
-#else /* not HAVE_POLL */
error_system_call (errno, syscall_connect);
break;
-#endif /* not HAVE_POLL */
#endif /* not HAVE_SELECT */
+#endif /* not HAVE_POLL */
}
{
int error;
struct hostent * entry = (UX_gethostbyname (host_name));
if (entry == 0)
return (0);
-#ifndef USE_HOSTENT_ADDR
+#ifdef HAVE_HOSTENT_H_ADDR_LIST
return (entry -> h_addr_list);
#else
{
/* -*-C-*-
-$Id: uxterm.c,v 1.27 2000/01/18 05:10:50 cph Exp $
+$Id: uxterm.c,v 1.28 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
#include "uxterm.h"
#include "uxio.h"
#include "ospty.h"
+#include "prims.h"
extern long EXFUN (arg_nonnegative_integer, (int));
extern long EXFUN (arg_index_integer, (int, long));
-#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO)
-
-#ifndef ISTRIP
-#define ISTRIP 0
-#endif
-#ifndef CS8
-#define CS8 0
-#endif
-#ifndef PARENB
-#define PARENB 0
-#endif
-
+#if defined(HAVE_TERMIOS_H) || defined(HAVE_TERMIO_H)
+# ifndef ISTRIP
+# define ISTRIP 0
+# endif
+# ifndef CS8
+# define CS8 0
+# endif
+# ifndef PARENB
+# define PARENB 0
+# endif
+# define TIO(s) (& ((s) -> tio))
#else
-#ifdef HAVE_BSD_TTY_DRIVER
-
+# ifdef HAVE_SGTTY_H
/* LPASS8 is new in 4.3, and makes cbreak mode provide all 8 bits. */
-#ifndef LPASS8
-#define LPASS8 0
-#endif
-
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* not HAVE_TERMIOS nor HAVE_TERMIO */
+# ifndef LPASS8
+# define LPASS8 0
+# endif
+# endif /* HAVE_SGTTY_H */
+#endif /* not HAVE_TERMIOS_H nor HAVE_TERMIO_H */
\f
struct terminal_state
{
#define TERMINAL_BUFFER(channel) ((terminal_table[(channel)]) . buffer)
#define TERMINAL_ORIGINAL_STATE(channel) ((terminal_table[(channel)]) . state)
-#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO)
-#define TIO(s) (& ((s) -> tio))
-#endif
-
void
DEFUN_VOID (UX_initialize_terminals)
{
unsigned int
DEFUN (terminal_state_get_ospeed, (s), Ttty_state * s)
{
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
return (cfgetospeed (TIO (s)));
#else
-#ifdef HAVE_TERMIO
+#ifdef HAVE_TERMIO_H
return (((TIO (s)) -> c_cflag) & CBAUD);
#else
-#ifdef HAVE_BSD_TTY_DRIVER
+#ifdef HAVE_SGTTY_H
return (s -> sg . sg_ospeed);
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* not HAVE_TERMIO */
-#endif /* not HAVE_TERMIOS */
+#endif /* HAVE_SGTTY_H */
+#endif /* not HAVE_TERMIO_H */
+#endif /* not HAVE_TERMIOS_H */
}
unsigned int
DEFUN (terminal_state_get_ispeed, (s), Ttty_state * s)
{
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
return (cfgetispeed (TIO (s)));
#else
-#ifdef HAVE_TERMIO
+#ifdef HAVE_TERMIO_H
return (((TIO (s)) -> c_cflag) & CBAUD);
#else
-#ifdef HAVE_BSD_TTY_DRIVER
+#ifdef HAVE_SGTTY_H
return (s -> sg . sg_ispeed);
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* not HAVE_TERMIO */
-#endif /* not HAVE_TERMIOS */
+#endif /* HAVE_SGTTY_H */
+#endif /* not HAVE_TERMIO_H */
+#endif /* not HAVE_TERMIOS_H */
}
void
Ttty_state * s AND
unsigned int b)
{
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
cfsetospeed ((TIO (s)), b);
#else
-#ifdef HAVE_TERMIO
+#ifdef HAVE_TERMIO_H
((TIO (s)) -> c_cflag) = ((((TIO (s)) -> c_cflag) &~ CBAUD) | b);
#else
-#ifdef HAVE_BSD_TTY_DRIVER
+#ifdef HAVE_SGTTY_H
(s -> sg . sg_ospeed) = b;
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* not HAVE_TERMIO */
-#endif /* not HAVE_TERMIOS */
+#endif /* HAVE_SGTTY_H */
+#endif /* not HAVE_TERMIO_H */
+#endif /* not HAVE_TERMIOS_H */
}
void
Ttty_state * s AND
unsigned int b)
{
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
cfsetispeed ((TIO (s)), b);
#else
-#ifdef HAVE_TERMIO
+#ifdef HAVE_TERMIO_H
((TIO (s)) -> c_cflag) =
((((TIO (s)) -> c_cflag) &~ CIBAUD) | (b << IBSHIFT));
#else
-#ifdef HAVE_BSD_TTY_DRIVER
+#ifdef HAVE_SGTTY_H
(s -> sg . sg_ispeed) = b;
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* not HAVE_TERMIO */
-#endif /* not HAVE_TERMIOS */
+#endif /* HAVE_SGTTY_H */
+#endif /* not HAVE_TERMIO_H */
+#endif /* not HAVE_TERMIOS_H */
}
int
DEFUN (terminal_state_cooked_output_p, (s), Ttty_state * s)
{
-#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO)
+#if defined(HAVE_TERMIOS_H) || defined(HAVE_TERMIO_H)
return ((((TIO (s)) -> c_oflag) & OPOST) != 0);
-#else /* not HAVE_TERMIOS nor HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIOS_H nor HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
return (((s -> sg . sg_flags) & LLITOUT) == 0);
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIOS or HAVE_TERMIO */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIOS_H or HAVE_TERMIO_H */
}
void
DEFUN (terminal_state_raw_output, (s), Ttty_state * s)
{
-#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO)
+#if defined(HAVE_TERMIOS_H) || defined(HAVE_TERMIO_H)
((TIO (s)) -> c_oflag) &=~ OPOST;
-#else /* not HAVE_TERMIOS nor HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIOS_H nor HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
(s -> sg . sg_flags) &=~ ALLDELAY;
(s -> lmode) |= LLITOUT;
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIOS or HAVE_TERMIO */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIOS_H or HAVE_TERMIO_H */
}
void
Ttty_state * s AND Tchannel channel)
{
Ttty_state * os = (& (TERMINAL_ORIGINAL_STATE (channel)));
-#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO)
+#if defined(HAVE_TERMIOS_H) || defined(HAVE_TERMIO_H)
((TIO (s)) -> c_oflag) |= (((TIO (os)) -> c_oflag) & OPOST);
-#else /* not HAVE_TERMIOS nor HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIOS_H nor HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
(s -> sg . sg_flags) =
(((s -> sg . sg_flags) &~ ALLDELAY) | ((os -> sg . sg_flags) & ALLDELAY));
(s -> lmode) &=~ ((os -> lmode) & LLITOUT);
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIOS or HAVE_TERMIO */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIOS_H or HAVE_TERMIO_H */
}
\f
int
DEFUN (terminal_state_buffered_p, (s), Ttty_state * s)
{
-#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO)
+#if defined(HAVE_TERMIOS_H) || defined(HAVE_TERMIO_H)
return ((((TIO (s)) -> c_lflag) & ICANON) != 0);
-#else /* not HAVE_TERMIOS nor HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIOS_H nor HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
return (((s -> sg . sg_flags) & (CBREAK | RAW)) == 0);
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIOS or HAVE_TERMIO */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIOS_H or HAVE_TERMIO_H */
}
void
int fd AND
int polling)
{
-#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO)
+#if defined(HAVE_TERMIOS_H) || defined(HAVE_TERMIO_H)
((TIO (s)) -> c_lflag) &=~ (ICANON | ECHO);
#ifdef IEXTEN
((TIO (s)) -> c_cflag) &=~ PARENB;
(((TIO (s)) -> c_cc) [VMIN]) = (polling ? 0 : 1);
(((TIO (s)) -> c_cc) [VTIME]) = 0;
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
{
cc_t disable = (UX_PC_VDISABLE (fd));
(((TIO (s)) -> c_cc) [VSTOP]) = disable;
}
#endif
-#else /* not HAVE_TERMIOS nor HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIOS_H nor HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
(s -> sg . sg_flags) &=~ (ECHO | CRMOD);
(s -> sg . sg_flags) |= (ANYP | CBREAK);
(s -> tc . t_stopc) = (-1);
(s -> tc . t_eofc) = (-1);
(s -> tc . t_brkc) = (-1);
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
(s -> ltc . t_rprntc) = (-1);
(s -> ltc . t_flushc) = (-1);
(s -> ltc . t_werasc) = (-1);
(s -> ltc . t_lnextc) = (-1);
-#endif /* HAVE_BSD_JOB_CONTROL */
+#endif /* HAVE_STRUCT_LTCHARS */
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIOS or HAVE_TERMIO */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIOS_H or HAVE_TERMIO_H */
}
void
{
terminal_state_nonbuffered (s, fd, 0);
-#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO)
+#if defined(HAVE_TERMIOS_H) || defined(HAVE_TERMIO_H)
((TIO (s)) -> c_lflag) &=~ ISIG;
-#else /* not HAVE_TERMIOS nor HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIOS_H nor HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
(s -> sg . sg_flags) &=~ CBREAK;
(s -> sg . sg_flags) |= RAW;
(s -> tc . t_intrc) = (-1);
(s -> tc . t_quitc) = (-1);
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
(s -> ltc . t_suspc) = (-1);
(s -> ltc . t_dsuspc) = (-1);
-#endif /* HAVE_BSD_JOB_CONTROL */
+#endif /* HAVE_STRUCT_LTCHARS */
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIOS or HAVE_TERMIO */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIOS_H or HAVE_TERMIO_H */
}
void
{
Ttty_state * os = (& (TERMINAL_ORIGINAL_STATE (channel)));
-#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO)
+#if defined(HAVE_TERMIOS_H) || defined(HAVE_TERMIO_H)
((TIO (s)) -> c_lflag) |= (ICANON | ISIG);
((TIO (s)) -> c_lflag) |= (((TIO (os)) -> c_lflag) & ECHO);
((TIO (s)) -> c_cflag) &=~ PARENB;
(((TIO (s)) -> c_cc) [VMIN]) = (((TIO (os)) -> c_cc) [VMIN]);
(((TIO (s)) -> c_cc) [VTIME]) = (((TIO (os)) -> c_cc) [VTIME]);
-#ifdef HAVE_TERMIOS
+#ifdef HAVE_TERMIOS_H
(((TIO (s)) -> c_cc) [VSTOP]) = (((TIO (os)) -> c_cc) [VSTOP]);
(((TIO (s)) -> c_cc) [VSTART]) = (((TIO (os)) -> c_cc) [VSTART]);
#endif
-#else /* not HAVE_TERMIOS nor HAVE_TERMIO */
-#ifdef HAVE_BSD_TTY_DRIVER
+#else /* not HAVE_TERMIOS_H nor HAVE_TERMIO_H */
+#ifdef HAVE_SGTTY_H
(s -> sg . sg_flags) &=~ (CBREAK | RAW);
(s -> sg . sg_flags) |= ANYP;
(s -> tc . t_stopc) = (os -> tc . t_stopc);
(s -> tc . t_eofc) = (os -> tc . t_eofc);
(s -> tc . t_brkc) = (os -> tc . t_brkc);
-#ifdef HAVE_BSD_JOB_CONTROL
+#ifdef HAVE_STRUCT_LTCHARS
(s -> ltc . t_suspc) = (os -> ltc . t_suspc);
(s -> ltc . t_dsuspc) = (os -> ltc . t_dsuspc);
(s -> ltc . t_rprntc) = (os -> ltc . t_rprntc);
(s -> ltc . t_flushc) = (os -> ltc . t_flushc);
(s -> ltc . t_werasc) = (os -> ltc . t_werasc);
(s -> ltc . t_lnextc) = (os -> ltc . t_lnextc);
-#endif /* HAVE_BSD_JOB_CONTROL */
+#endif /* HAVE_STRUCT_LTCHARS */
-#endif /* HAVE_BSD_TTY_DRIVER */
-#endif /* HAVE_TERMIOS or HAVE_TERMIO */
+#endif /* HAVE_SGTTY_H */
+#endif /* HAVE_TERMIOS_H or HAVE_TERMIO_H */
}
\f
unsigned int
set_terminal_state (channel, (&s));
}
-#ifndef NO_BAUD_CONVERSION
-static unsigned int baud_convert [] =
-#ifdef _HPUX
- {
- 0, 50, 75, 110, 135, 150, 200, 300, 600, 900, 1200,
- 1800, 2400, 3600, 4800, 7200, 9600, 19200, 38400
- };
-#else
- {
- 0, 50, 75, 110, 135, 150, 200, 300, 600, 1200,
- 1800, 2400, 4800, 9600, 19200, 38400
- };
-#endif
-
-#define BAUD_CONVERT_LENGTH \
- ((sizeof (baud_convert)) / (sizeof (baud_convert[0])))
-#endif /* NO_BAUD_CONVERSION */
-
unsigned int
DEFUN (arg_baud_index, (argument), unsigned int argument)
{
-#ifdef NO_BAUD_CONVERSION
- return (arg_nonnegative_integer (argument));
-#else
- return (arg_index_integer (argument, BAUD_CONVERT_LENGTH));
+ unsigned long index = (arg_nonnegative_integer (argument));
+ switch (index)
+ {
+ case B0:
+ case B50:
+ case B75:
+ case B110:
+ case B134:
+ case B150:
+ case B200:
+ case B300:
+ case B600:
+ case B1200:
+ case B1800:
+ case B2400:
+ case B4800:
+ case B9600:
+ case B19200:
+ case B38400:
+#ifdef B57600
+ case B57600:
+#endif
+#ifdef B115200
+ case B115200:
+#endif
+#ifdef B230400
+ case B230400:
+#endif
+#ifdef B460800
+ case B460800:
+#endif
+#ifdef B500000
+ case B500000:
+#endif
+#ifdef B576000
+ case B576000:
+#endif
+#ifdef B921600
+ case B921600:
+#endif
+#ifdef B1000000
+ case B1000000:
+#endif
+#ifdef B1152000
+ case B1152000:
+#endif
+#ifdef B1500000
+ case B1500000:
+#endif
+#ifdef B2000000
+ case B2000000:
+#endif
+#ifdef B2500000
+ case B2500000:
+#endif
+#ifdef B3000000
+ case B3000000:
+#endif
+#ifdef B3500000
+ case B3500000:
+#endif
+#ifdef B4000000
+ case B4000000:
#endif
+ break;
+ default:
+ error_bad_range_arg (argument);
+ }
+ return (index);
}
unsigned int
DEFUN (OS_baud_index_to_rate, (index), unsigned int index)
{
-#ifdef NO_BAUD_CONVERSION
- return (index);
-#else
- return (baud_convert [index]);
+ switch (index)
+ {
+ case B0: return (0);
+ case B50: return (50);
+ case B75: return (75);
+ case B110: return (110);
+ case B134: return (134);
+ case B150: return (150);
+ case B200: return (200);
+ case B300: return (300);
+ case B600: return (600);
+ case B1200: return (1200);
+ case B1800: return (1800);
+ case B2400: return (2400);
+ case B4800: return (4800);
+ case B9600: return (9600);
+ case B19200: return (19200);
+ case B38400: return (38400);
+#ifdef B57600
+ case B57600: return (57600);
+#endif
+#ifdef B115200
+ case B115200: return (115200);
+#endif
+#ifdef B230400
+ case B230400: return (230400);
+#endif
+#ifdef B460800
+ case B460800: return (460800);
+#endif
+#ifdef B500000
+ case B500000: return (500000);
+#endif
+#ifdef B576000
+ case B576000: return (576000);
+#endif
+#ifdef B921600
+ case B921600: return (921600);
+#endif
+#ifdef B1000000
+ case B1000000: return (1000000);
+#endif
+#ifdef B1152000
+ case B1152000: return (1152000);
+#endif
+#ifdef B1500000
+ case B1500000: return (1500000);
+#endif
+#ifdef B2000000
+ case B2000000: return (2000000);
+#endif
+#ifdef B2500000
+ case B2500000: return (2500000);
#endif
+#ifdef B3000000
+ case B3000000: return (3000000);
+#endif
+#ifdef B3500000
+ case B3500000: return (3500000);
+#endif
+#ifdef B4000000
+ case B4000000: return (4000000);
+#endif
+ default: abort (); return (0);
+ }
}
int
DEFUN (OS_baud_rate_to_index, (rate), unsigned int rate)
{
-#ifdef NO_BAUD_CONVERSION
- return (rate);
-#else
- unsigned int * scan = baud_convert;
- unsigned int * end = (scan + BAUD_CONVERT_LENGTH);
- while (scan < end)
- if ((*scan++) == rate)
- return ((scan - 1) - baud_convert);
- return (-1);
+ switch (rate)
+ {
+ case 0: return (B0);
+ case 50: return (B50);
+ case 75: return (B75);
+ case 110: return (B110);
+ case 134: return (B134);
+ case 150: return (B150);
+ case 200: return (B200);
+ case 300: return (B300);
+ case 600: return (B600);
+ case 1200: return (B1200);
+ case 1800: return (B1800);
+ case 2400: return (B2400);
+ case 4800: return (B4800);
+ case 9600: return (B9600);
+ case 19200: return (B19200);
+ case 38400: return (B38400);
+#ifdef B57600
+ case 57600: return (B57600);
+#endif
+#ifdef B115200
+ case 115200: return (B115200);
+#endif
+#ifdef B230400
+ case 230400: return (B230400);
+#endif
+#ifdef B460800
+ case 460800: return (B460800);
+#endif
+#ifdef B500000
+ case 500000: return (B500000);
+#endif
+#ifdef B576000
+ case 576000: return (B576000);
+#endif
+#ifdef B921600
+ case 921600: return (B921600);
+#endif
+#ifdef B1000000
+ case 1000000: return (B1000000);
+#endif
+#ifdef B1152000
+ case 1152000: return (B1152000);
+#endif
+#ifdef B1500000
+ case 1500000: return (B1500000);
+#endif
+#ifdef B2000000
+ case 2000000: return (B2000000);
#endif
+#ifdef B2500000
+ case 2500000: return (B2500000);
+#endif
+#ifdef B3000000
+ case 3000000: return (B3000000);
+#endif
+#ifdef B3500000
+ case 3500000: return (B3500000);
+#endif
+#ifdef B4000000
+ case 4000000: return (B4000000);
+#endif
+ default: return (-1);
+ }
}
unsigned int
return (UX_SC_JOB_CONTROL ());
}
\f
-#ifdef HAVE_PTYS
-
int
DEFUN_VOID (OS_have_ptys_p)
{
+#ifdef HAVE_GRANTPT
return (1);
+#else
+ static int result = 0;
+ static int result_valid = 0;
+ const char * p1;
+ if (result_valid)
+ return (result);
+ for (p1 = "pqrstuvwxyzPQRST"; ((*p1) != 0); p1 += 1)
+ {
+ char master_name [24];
+ struct stat s;
+ sprintf (master_name, "/dev/pty%c0", (*p1));
+ retry_stat:
+ if ((UX_stat (master_name, (&s))) < 0)
+ {
+ if (errno == EINTR)
+ goto retry_stat;
+ continue;
+ }
+ result = 1;
+ result_valid = 1;
+ return (result);
+ }
+ result = 0;
+ result_valid = 1;
+ return (result);
+#endif
}
-#ifdef FIRST_PTY_LETTER
-
-#define PTY_DECLARATIONS \
- int c; \
- int i
-
-#define PTY_ITERATION \
- for (c = FIRST_PTY_LETTER; (c <= 'z'); c += 1) \
- for (i = 0; (i < 16); i += 1)
-
-#define PTY_MASTER_NAME_SPRINTF(master_name) \
- sprintf ((master_name), "/dev/pty%c%x", c, i)
+static CONST char *
+DEFUN (open_pty_master_bsd, (master_fd, master_fname),
+ Tchannel * master_fd AND
+ CONST char ** master_fname)
+{
+ static char master_name [24];
+ static char slave_name [24];
+ const char * p1;
+ const char * p2;
+ int fd;
-#define PTY_SLAVE_NAME_SPRINTF(slave_name, fd) \
-{ \
- sprintf ((slave_name), "/dev/tty%c%x", c, i); \
- if ((UX_access ((slave_name), (R_OK | W_OK))) < 0) \
- { \
- UX_close (fd); \
- continue; \
- } \
+ for (p1 = "pqrstuvwxyzPQRST"; ((*p1) != 0); p1 += 1)
+ for (p2 = "0123456789abcdef"; ((*p2) != 0); p2 += 1)
+ {
+ sprintf (master_name, "/dev/pty%c%c", (*p1), (*p2));
+ sprintf (slave_name, "/dev/tty%c%c", (*p1), (*p2));
+ retry_open:
+ fd = (UX_open (master_name, O_RDWR, 0));
+ if (fd < 0)
+ {
+ if (errno == ENOENT)
+ return (0);
+ if (errno != EINTR)
+ continue;
+ deliver_pending_interrupts ();
+ goto retry_open;
+ }
+ if ((UX_access (slave_name, (R_OK | W_OK))) < 0)
+ {
+ UX_close (fd);
+ continue;
+ }
+ MAKE_CHANNEL (fd, channel_type_unix_pty_master, (*master_fd) =);
+ (*master_fname) = master_name;
+ return (slave_name);
+ }
+ return (0);
}
-#endif /* FIRST_PTY_LETTER */
-
/* Open an available pty, putting channel in (*ptyv),
and return the file name of the pty.
Signal error if none available. */
Tchannel * master_fd AND
CONST char ** master_fname)
{
- static char master_name [24];
- static char slave_name [24];
- int fd;
- PTY_DECLARATIONS;
-
-#ifdef PTY_ITERATION
- PTY_ITERATION
-#endif
+#ifdef HAVE_GRANTPT
+ while (1)
{
- PTY_MASTER_NAME_SPRINTF (master_name);
- retry_open:
- fd = (UX_open (master_name, O_RDWR, 0));
+ static char slave_name [24];
+ int fd = (UX_open ("/dev/ptmx", O_RDWR, 0));
if (fd < 0)
{
- if (errno != EINTR)
+ if (errno == EINTR)
{
-#ifdef PTY_ITERATION
+ deliver_pending_interrupts ();
continue;
-#else
- error_system_call (errno, syscall_open);
-#endif
}
- deliver_pending_interrupts ();
- goto retry_open;
+ /* Try BSD open. This is needed for Linux which might have
+ Unix98 support in the library but not the kernel. */
+ return (open_pty_master_bsd (master_fd, master_fname));
}
- PTY_SLAVE_NAME_SPRINTF (slave_name, fd);
+#ifdef sonyrisc
+ sony_block_sigchld ();
+#endif
+ grantpt (fd);
+ unlockpt (fd);
+ strcpy (slave_name, (ptsname (fd)));
+#ifdef sonyrisc
+ sony_unblock_sigchld ();
+#endif
MAKE_CHANNEL (fd, channel_type_unix_pty_master, (*master_fd) =);
- (*master_fname) = master_name;
+ (*master_fname) = "/dev/ptmx";
return (slave_name);
}
- error_external_return ();
- return (0);
+
+#else /* not HAVE_GRANTPT */
+
+ if (!OS_have_ptys_p ())
+ error_unimplemented_primitive ();
+ return (open_pty_master_bsd (master_fd, master_fname));
+
+#endif /* not HAVE_GRANTPT */
}
-\f
+
void
DEFUN (OS_pty_master_send_signal, (channel, sig), Tchannel channel AND int sig)
{
(syscall_ioctl_TIOCSIGSEND,
(UX_ioctl ((CHANNEL_DESCRIPTOR (channel)), TIOCSIGSEND, sig)));
#else
-#if defined(HAVE_POSIX_SIGNALS) || defined(HAVE_BSD_JOB_CONTROL)
- int gid;
- STD_UINT_SYSTEM_CALL
- (syscall_tcgetpgrp, gid, (UX_tcgetpgrp (CHANNEL_DESCRIPTOR (channel))));
+ int gid = (UX_tcgetpgrp (CHANNEL_DESCRIPTOR (channel)));
+ if (gid < 0)
+ {
+ if (errno == ENOSYS)
+ error_unimplemented_primitive ();
+ else
+ error_system_call (errno, syscall_tcgetpgrp);
+ }
STD_VOID_SYSTEM_CALL (syscall_kill, (UX_kill ((-gid), sig)));
-#else
- error_unimplemented_primitive ();
-#endif /* not (HAVE_POSIX_SIGNALS or HAVE_BSD_JOB_CONTROL) */
-#endif /* not TIOCSIGSEND */
-}
-
-#else /* not HAVE_PTYS */
-
-int
-DEFUN_VOID (OS_have_ptys_p)
-{
- return (0);
-}
-
-CONST char *
-DEFUN (OS_open_pty_master, (master_fd, master_fname),
- Tchannel * master_fd AND
- CONST char ** master_fname)
-{
- error_unimplemented_primitive ();
-}
-
-void
-DEFUN (OS_pty_master_send_signal, (channel, sig), Tchannel channel AND int sig)
-{
- error_unimplemented_primitive ();
+#endif
}
-#endif /* not HAVE_PTYS */
-
void
DEFUN (OS_pty_master_kill, (channel), Tchannel channel)
{
/* -*-C-*-
-$Id: uxtop.c,v 1.24 2000/05/20 18:59:14 cph Exp $
+$Id: uxtop.c,v 1.25 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
#include "errors.h"
#include "option.h"
#include "config.h"
+#include "default.h"
#include "extern.h"
extern void EXFUN (UX_initialize_channels, (void));
UX_initialize_directory_reader ();
OS_Name = SYSTEM_NAME;
OS_Variant = SYSTEM_VARIANT;
-#ifdef _SUNOS
+#if defined(_SUNOS) || defined(_SUNOS3) || defined(_SUNOS4)
vadvise (VA_ANOM); /* Anomolous paging, don't try to guess. */
#endif
}
}
}
-#ifdef _HPUX
+#ifdef __HPUX__
#define NEED_ERRLIST_DEFINITIONS
#endif
/* -*-C-*-
-$Id: uxtrap.c,v 1.29 2000/01/18 05:11:09 cph Exp $
+$Id: uxtrap.c,v 1.30 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
}
case trap_state_exit:
termination_trap ();
+
+ default:
+ break;
}
fflush (stdout);
}
}
\f
-static struct trap_recovery_info dummy_recovery_info =
-{
- STATE_UNKNOWN,
- SHARP_F,
- SHARP_F,
- SHARP_F
-};
-
struct ux_sig_code_desc
{
int signo;
struct trap_recovery_info * trinfo AND
SCHEME_OBJECT * new_stack_pointer)
{
- SCHEME_OBJECT handler;
+ SCHEME_OBJECT handler = SHARP_F;
SCHEME_OBJECT signal_name, signal_code;
int stack_recovered_p = (new_stack_pointer != 0);
long saved_mask = (FETCH_INTERRUPT_MASK ());
setup_trap_frame (0, 0, 0, (&trinfo), new_stack_pointer);
}
-#if !defined(HAVE_SIGCONTEXT) || !defined(HAS_COMPILER_SUPPORT) || defined(USE_STACKLETS)
+#if !defined(HAVE_STRUCT_SIGCONTEXT) || !defined(HAS_COMPILER_SUPPORT) || defined(USE_STACKLETS)
+
+static struct trap_recovery_info dummy_recovery_info =
+{
+ STATE_UNKNOWN,
+ SHARP_F,
+ SHARP_F,
+ SHARP_F
+};
static void
DEFUN (continue_from_trap, (signo, info, scp),
setup_trap_frame (signo, info, scp, (&dummy_recovery_info), 0);
}
-#else /* HAVE_SIGCONTEXT and HAS_COMPILER_SUPPORT and not USE_STACKLETS */
+#else /* HAS_COMPILER_SUPPORT and not USE_STACKLETS */
\f
/* Heuristic recovery from Unix signals (traps).
{
/* In compiled code. */
SCHEME_OBJECT * block_addr;
+#ifdef HAVE_FULL_SIGCONTEXT
SCHEME_OBJECT * maybe_free;
+#endif
block_addr =
(pc_in_builtin
? ((SCHEME_OBJECT *) NULL)
return (0);
}
-#endif /* HAVE_SIGCONTEXT and HAS_COMPILER_SUPPORT and not USE_STACKLETS */
+#endif /* HAS_COMPILER_SUPPORT and not USE_STACKLETS */
\f
/* -*-C-*-
-$Id: uxtrap.h,v 1.28 1999/01/02 06:11:34 cph Exp $
+$Id: uxtrap.h,v 1.29 2000/12/05 21:23:49 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
\f
/* Machine/OS-dependent section (long) */
-#ifdef hp9000s300
+#if defined(hp9000s300) || defined(__hp9000s300)
#include <sys/sysmacros.h>
#include <machine/sendsig.h>
#endif /* hp9000s300 */
\f
-#ifdef hp9000s800
+#if defined(hp9000s800) || defined(__hp9000s800)
/* The bottom 2 bits of the PC are protection bits.
They should be masked away before looking at the PC.
debugging and if there is ever a hope to restart the code.
*/
-#ifdef _HPUX
+#ifdef __HPUX__
/* HPUX 09.x does not have siginfo, but HPUX 10.x does. This can be
tested by the definition of SA_SIGINFO. Since we want to support
} \
}
-#else /* not _HPUX, BSD ? */
+#else /* not __HPUX__, BSD ? */
# ifndef sc_pc
# define sc_pc sc_pcoqh
# endif /* sc_pc */
-#endif /* _HPUX */
+#endif /* __HPUX__ */
#endif /* hp9000s800 */
\f
#endif /* vax */
\f
#ifdef mips
-#ifdef _IRIX
+#ifdef __IRIX__
/* Information on sigcontext structure in signal.h */
(SIGSEGV, (~ 0L), ENXIO, "Read beyond mapped object"); \
}
-#else /* not _IRIX */
+#else /* not __IRIX__ */
#ifndef _SYSV4
/* Information on sigcontext structure in signal.h */
}
#endif /* _SYSV4 */
-#endif /* _IRIX */
+#endif /* __IRIX__ */
#endif /* mips */
\f
-#if defined(i386) && defined(_MACH_UNIX)
-/* The following are true for Mach (BSD 4.3 compatible).
- I don't know about SCO or other versions.
- */
-
-#define HAVE_FULL_SIGCONTEXT
-#define PROCESSOR_NREGS 8
-#define FULL_SIGCONTEXT_NREGS 8
-
-#define SIGCONTEXT sigcontext
-#define SIGCONTEXT_SP(scp) ((scp)->sc_esp)
-#define SIGCONTEXT_PC(scp) ((scp)->sc_eip)
-#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->sc_edi)
-#define FULL_SIGCONTEXT_FIRST_REG(scp) (&((scp)->sc_edi))
+#ifdef __IA32__
-/* INITIALIZE_UX_SIGNAL_CODES should be defined. */
-
-#endif /* i386 */
-
-#ifdef __linux
+#ifdef __linux__
/* Linux signal handlers are called with one argument -- the `signo'.
There's an alleged "iBCS signal stack" register dump just above it.
Thus, the fictitious `info' argument to the handler is actually the
- first member of this register dump (described by struct sigcontext,
- below). Unfortunately, kludging SIGINFO_CODE to access the sc_trapno
- will fail later on when looking at the saved_info. */
+ first member of this register dump (described by struct
+ linux_sigcontext, below). Unfortunately, kludging SIGINFO_CODE to
+ access the sc_trapno will fail later on when looking at the
+ saved_info. */
#define SIGINFO_T long
#define SIGINFO_VALID_P(info) (0)
#define SIGINFO_CODE(info) (0)
#define FULL_SIGCONTEXT_PC SIGCONTEXT_PC
#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->sc_edi)
-#endif /* __linux */
+#endif /* __linux__ */
+
+#ifdef _MACH_UNIX
+/* The following are true for Mach (BSD 4.3 compatible).
+ I don't know about SCO or other versions. */
+
+#define HAVE_FULL_SIGCONTEXT
+#define PROCESSOR_NREGS 8
+#define FULL_SIGCONTEXT_NREGS 8
+
+#define SIGCONTEXT sigcontext
+#define SIGCONTEXT_SP(scp) ((scp)->sc_esp)
+#define SIGCONTEXT_PC(scp) ((scp)->sc_eip)
+#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->sc_edi)
+#define FULL_SIGCONTEXT_FIRST_REG(scp) (&((scp)->sc_edi))
+
+/* INITIALIZE_UX_SIGNAL_CODES should be defined. */
+
+#endif /* _MACH_UNIX */
+
+#endif /* __IA32__ */
\f
#ifdef __alpha
#ifdef _AIX
/* For now */
-#define SIGCONTEXT sigcontext
-#define SIGCONTEXT_SP(scp) 0
-#define SIGCONTEXT_PC(scp) 0
+# define SIGCONTEXT sigcontext
+# define SIGCONTEXT_SP(scp) 0
+# define SIGCONTEXT_PC(scp) 0
#endif /* _AIX */
\f
#ifndef SIGINFO_T
-#define SIGINFO_T int
-#define SIGINFO_VALID_P(info) (1)
-#define SIGINFO_CODE(info) (info)
+# define SIGINFO_T int
+# define SIGINFO_VALID_P(info) (1)
+# define SIGINFO_CODE(info) (info)
+#endif
+
+#ifndef HAVE_STRUCT_SIGCONTEXT
+ struct sigcontext { long sc_sp; long sc_pc; };
#endif
#ifndef SIGCONTEXT
-#define SIGCONTEXT sigcontext
-#define SIGCONTEXT_SP(scp) ((scp)->sc_sp)
-#define SIGCONTEXT_PC(scp) ((scp)->sc_pc)
-#endif /* SIGCONTEXT */
+# define SIGCONTEXT sigcontext
+# define SIGCONTEXT_SP(scp) ((scp) -> sc_sp)
+# define SIGCONTEXT_PC(scp) ((scp) -> sc_pc)
+#endif
#ifndef FULL_SIGCONTEXT
-
-#define FULL_SIGCONTEXT SIGCONTEXT
-#define FULL_SIGCONTEXT_SP SIGCONTEXT_SP
-#define FULL_SIGCONTEXT_PC SIGCONTEXT_PC
-
-#define DECLARE_FULL_SIGCONTEXT(name) \
- struct FULL_SIGCONTEXT * name
-
-#define INITIALIZE_FULL_SIGCONTEXT(partial, full) \
- ((full) = ((struct FULL_SIGCONTEXT *) (partial)))
-
-#endif /* not FULL_SIGCONTEXT */
+# define FULL_SIGCONTEXT SIGCONTEXT
+# define FULL_SIGCONTEXT_SP SIGCONTEXT_SP
+# define FULL_SIGCONTEXT_PC SIGCONTEXT_PC
+# define DECLARE_FULL_SIGCONTEXT(name) struct FULL_SIGCONTEXT * name
+# define INITIALIZE_FULL_SIGCONTEXT(partial, full) \
+ ((full) = ((struct FULL_SIGCONTEXT *) (partial)))
+#endif
#ifndef FULL_SIGCONTEXT_NREGS
-#define FULL_SIGCONTEXT_NREGS 0
-#define FULL_SIGCONTEXT_FIRST_REG(scp) ((int *) 0)
+# define FULL_SIGCONTEXT_NREGS 0
+# define FULL_SIGCONTEXT_FIRST_REG(scp) ((int *) 0)
#endif
#ifndef PROCESSOR_NREGS
-#define PROCESSOR_NREGS 0
+# define PROCESSOR_NREGS 0
#endif
#ifndef FULL_SIGCONTEXT_SCHSP
-#define FULL_SIGCONTEXT_SCHSP FULL_SIGCONTEXT_SP
+# define FULL_SIGCONTEXT_SCHSP FULL_SIGCONTEXT_SP
#endif
#ifndef INITIALIZE_UX_SIGNAL_CODES
-#define INITIALIZE_UX_SIGNAL_CODES()
+# define INITIALIZE_UX_SIGNAL_CODES()
#endif
/* PCs must be aligned according to this. */
# define PLAUSIBLE_CC_BLOCK_P(block) 0
#endif
-#if !(defined (_NEXTOS) && (_NEXTOS_VERSION >= 20))
+#ifndef _NEXTOS
#ifdef _AIX
extern int _etext;
#define get_etext() (&_etext)
#else /* not _AIX */
-#ifdef __linux
+#ifdef __linux__
extern unsigned int etext;
-#else /* not __linux */
-#if !(defined (_HPUX) && (_HPUX_VERSION >= 80) && defined (hp9000s300))
-extern long etext;
#else
extern int etext;
-#endif /* _HPUX ... */
-#endif /* __linux */
+#endif
#endif /* _AIX */
#ifndef get_etext
# define get_etext() (&etext)
/* -*-C-*-
-$Id: version.h,v 11.175 2000/11/28 18:28:05 cph Exp $
+$Id: version.h,v 11.176 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1988-2000 Massachusetts Institute of Technology
/* Scheme system release version */
-#ifndef RELEASE
-#define RELEASE "7.5.11"
+#ifndef SCHEME_RELEASE
+#define SCHEME_RELEASE "7.5.12"
#endif
/* Microcode release version */
-#ifndef VERSION
-#define VERSION 11
+#ifndef SCHEME_VERSION
+#define SCHEME_VERSION 14
#endif
-#ifndef SUBVERSION
-#define SUBVERSION 171
+#ifndef SCHEME_SUBVERSION
+#define SCHEME_SUBVERSION 0
#endif
/* -*-C-*-
-$Id: wabbit.c,v 1.7 1999/01/02 06:11:34 cph Exp $
+$Id: wabbit.c,v 1.8 2000/12/05 21:23:49 cph Exp $
-Copyright (c) 1994-1999 Massachusetts Institute of Technology
+Copyright (c) 1994-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
last_object, * last_object_end, * last_nmv, * last_hare, last_hare_head,
magic_cookie, saved_cookie, * saved_addr;
- magic_cookie = SHARP_F;
last_object = SHARP_F;
+ last_object_end = 0;
last_nmv = (scan - 2); /* Make comparison fail until */
last_nmv_length = 0; /* an NMV is found. */
last_hare = (scan - 2); /* Same here */
last_hare_head = SHARP_F;
+ magic_cookie = SHARP_F;
+ saved_cookie = SHARP_F;
+ saved_addr = 0;
new_space_free = * new_space_free_loc;
low_heap = Constant_Top;
for ( ; scan != new_space_free; scan++)
default:
sprintf (gc_death_message_buffer,
"wabbit_hunting_gcloop: bad type code (0x%02x)",
- (OBJECT_TYPE (this_object)));
+ ((unsigned int) (OBJECT_TYPE (this_object))));
gc_death (TERM_INVALID_TYPE_CODE,
gc_death_message_buffer,
scan, new_space_free);
/* -*-C-*-
-$Id: x11.h,v 1.16 1999/01/02 06:11:34 cph Exp $
+$Id: x11.h,v 1.17 2000/12/05 21:23:49 cph Exp $
-Copyright (c) 1989-1999 Massachusetts Institute of Technology
+Copyright (c) 1989-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
unsigned long mouse_pixel;
};
-#ifdef __STDC__
+#ifdef HAVE_STDC
/* This incomplete type definition is needed because the scope of the
implicit definition in the following typedefs is incorrect. */
struct xwindow;
/* -*-C-*-
-$Id: x11base.c,v 1.75 2000/10/01 02:15:58 cph Exp $
+$Id: x11base.c,v 1.76 2000/12/05 21:23:49 cph Exp $
Copyright (c) 1989-2000 Massachusetts Institute of Technology
fprintf (stderr, "\nX Error: %s\n", buffer);
fprintf (stderr, " Request code: %d\n",
(error_event -> request_code));
- fprintf (stderr, " Error serial: %x\n", (error_event -> serial));
+ fprintf (stderr, " Error serial: %lx\n", (error_event -> serial));
fflush (stderr);
#if 0
error_external_return ();
{
fprintf (stderr,
"ClientMessage; message_type = 0x%x, format = %d",
- ((event -> xclient) . message_type),
+ ((unsigned int) ((event -> xclient) . message_type)),
((event -> xclient) . format));
goto debug_done;
}
break;
case PropertyNotify:
{
- fprintf (stderr,
- "PropertyNotify; window=%d, atom=%d, time=%d, state=%d",
- ((event -> xproperty) . window),
- ((event -> xproperty) . atom),
- ((event -> xproperty) . time),
- ((event -> xproperty) . state));
+ fprintf
+ (stderr,
+ "PropertyNotify; window=%ld, atom=%ld, time=%ld, state=%d",
+ ((event -> xproperty) . window),
+ ((event -> xproperty) . atom),
+ ((event -> xproperty) . time),
+ ((event -> xproperty) . state));
goto debug_done;
}
case SelectionNotify:
{
- fprintf (stderr,
- "SelectionNotify; req=%d, sel=%d, targ=%d, prop=%d, t=%d",
- ((event -> xselection) . requestor),
- ((event -> xselection) . selection),
- ((event -> xselection) . target),
- ((event -> xselection) . property),
- ((event -> xselection) . time));
+ fprintf
+ (stderr,
+ "SelectionNotify; req=%ld, sel=%ld, targ=%ld, prop=%ld, t=%ld",
+ ((event -> xselection) . requestor),
+ ((event -> xselection) . selection),
+ ((event -> xselection) . target),
+ ((event -> xselection) . property),
+ ((event -> xselection) . time));
goto debug_done;
}
default: type_name = 0; break;
if (result == SHARP_F)
fprintf (stderr, "#f");
else if (FIXNUM_P (result))
- fprintf (stderr, "%d", (FIXNUM_TO_LONG (result)));
+ fprintf (stderr, "%ld", (FIXNUM_TO_LONG (result)));
else
fprintf (stderr, "[vector]");
fprintf (stderr, "\n");
Atom type = (arg_ulong_integer (4));
int format = (arg_nonnegative_integer (5));
int mode = (arg_index_integer (6, 3));
- CONST char * data;
+ CONST char * VOLATILE data = 0;
unsigned long dlen;
unsigned char status;
/* -*-C-*-
-$Id: xdebug.c,v 9.33 1999/01/02 06:11:34 cph Exp $
+$Id: xdebug.c,v 9.34 2000/12/05 21:23:49 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2000 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
{
occurrences += 1;
if (print_p)
-#ifndef b32
- outf_console("Location = 0x%lx; Contents = 0x%lx\n",
+#if (SIZEOF_UNSIGNED_LONG == 4)
+ outf_console("Location = 0x%08lx; Contents = 0x%08lx\n",
((long) Where), ((long) (*Where)));
#else
- outf_console("Location = 0x%08lx; Contents = 0x%08lx\n",
+ outf_console("Location = 0x%lx; Contents = 0x%lx\n",
((long) Where), ((long) (*Where)));
#endif
if (store_p)
if (print_p)
{
putchar('\n');
-#ifndef b32
- outf_console("*** Looking for Obj = 0x%lx; Find_Mode = %2ld ***\n",
+#if (SIZEOF_UNSIGNED_LONG == 4)
+ outf_console("*** Looking for Obj = 0x%08lx; Find_Mode = %2ld ***\n",
((long) Obj), ((long) Find_Mode));
#else
- outf_console("*** Looking for Obj = 0x%08lx; Find_Mode = %2ld ***\n",
+ outf_console("*** Looking for Obj = 0x%lx; Find_Mode = %2ld ***\n",
((long) Obj), ((long) Find_Mode));
#endif
}
{
fast SCHEME_OBJECT *End = &Where[How_Many];
-#ifndef b32
- outf_console ("\n*** Memory from 0x%lx to 0x%lx (excluded) ***\n",
+#if (SIZEOF_UNSIGNED_LONG == 4)
+ outf_console ("\n*** Memory from 0x%08lx to 0x%08lx (excluded) ***\n",
((long) Where), ((long) End));
while (Where < End)
{
- outf_console ("0x%lx\n", ((long) (*Where++)));
+ outf_console ("0x%0l8x\n", ((long) (*Where++)));
}
#else
- outf_console ("\n*** Memory from 0x%08lx to 0x%08lx (excluded) ***\n",
+ outf_console ("\n*** Memory from 0x%lx to 0x%lx (excluded) ***\n",
((long) Where), ((long) End));
while (Where < End)
{
- outf_console ("0x%0l8x\n", ((long) (*Where++)));
+ outf_console ("0x%lx\n", ((long) (*Where++)));
}
#endif
outf_console ("Done.\n");
projects / mit-scheme.git / commitdiff