ln -s $sbcl_arch-linux-os.h target-arch-os.h
ln -s linux-os.h target-os.h
;;
+ OSF1)
+ # it's changed name twice since it was called OSF/1: clearly
+ # the marketers forgot to tell the engineers about Digital Unix
+ # _or_ OSF/1 ...
+ printf ' :osf1' >> $ltf
+ ln -s Config.$sbcl_arch-osf1 Config
+ ln -s $sbcl_arch-osf1-os.h target-arch-os.h
+ ln -s osf1-os.h target-os.h
+ ;;
*BSD)
printf ' :bsd' >> $ltf
ln -s $sbcl_arch-bsd-os.h target-arch-os.h
;;; code for foreign symbol lookup should be here.
(defun find-foreign-symbol-in-table (name table)
(let ((prefixes
- #!+(or linux freebsd) #("" "ldso_stub__")
- #!+openbsd #("")
- #!+sunos #("" "ldso_stub__")))
+ #!+(or osf1 sunos linux freebsd) #("" "ldso_stub__")
+ #!+openbsd #("")))
(declare (notinline some)) ; to suppress bug 117 bogowarning
(some (lambda (prefix)
(gethash (concatenate 'string prefix name)
;; pointer is used. On a system which doesn't support that
;; extension, it'll have to be rewritten somehow.
;;
- ;; SunOS provides almost as useful an extension: if given a null
+ ;; SunOS and OSF/1 provide almost as useful an extension: if given a null
;; buffer pointer, it will automatically allocate size space. The
;; KLUDGE in this solution arises because we have just read off
;; PATH_MAX+1 from the Solaris header files and stuck it in here as
;; a constant. Going the grovel_headers route doesn't seem to be
;; helpful, either, as Solaris doesn't export PATH_MAX from
;; unistd.h.
- #!-(or linux openbsd freebsd sunos) (,stub,)
- #!+(or linux openbsd freebsd sunos)
+ #!-(or linux openbsd freebsd sunos osf1) (,stub,)
+ #!+(or linux openbsd freebsd sunos osf1)
(or (newcharstar-string (alien-funcall (extern-alien "getcwd"
(function (* char)
(* char)
size-t))
nil
#!+(or linux openbsd freebsd) 0
- #!+sunos 1025))
+ #!+(or sunos osf1) 1025))
(simple-perror "getcwd")))
;;; Return the Unix current directory as a SIMPLE-STRING terminated
#!+linux
(progn
(def!constant read-only-space-start #x20000000)
- (def!constant read-only-space-end #x24000000)
+ (def!constant read-only-space-end #x24000000))
- (def!constant static-space-start #x28000000)
- (def!constant static-space-end #x2c000000)
+#!+osf1
+(progn
+ (defconstant read-only-space-start #x10000000)
+ (defconstant read-only-space-end #x25000000))
- ;; this is used in PURIFY as part of a sloppy check to see if a pointer
- ;; is in dynamic space. Chocolate brownie for the first person to fix it
- ;; -dan 20010502
- (def!constant dynamic-space-start #x30000000)
- (def!constant dynamic-space-end #x3fff0000)
- (def!constant dynamic-0-space-start #x30000000)
- (def!constant dynamic-0-space-end #x3fff0000)
-
- (def!constant dynamic-1-space-start #x40000000)
- (def!constant dynamic-1-space-end #x4fff0000)
+(def!constant static-space-start #x28000000)
+(def!constant static-space-end #x2c000000)
- (def!constant control-stack-start #x50000000)
- (def!constant control-stack-end #x51000000)
+;; this is used in PURIFY as part of a sloppy check to see if a pointer
+;; is in dynamic space. Chocolate brownie for the first person to fix it
+;; -dan 20010502
+(def!constant dynamic-space-start #x30000000)
+(def!constant dynamic-space-end #x3fff0000)
- (def!constant binding-stack-start #x70000000)
- (def!constant binding-stack-end #x71000000))
+(def!constant dynamic-0-space-start #x30000000)
+(def!constant dynamic-0-space-end #x3fff0000)
-#!+osf1 ;as if
-(progn
- (defparameter read-only-space-start #x10000000)
- (defparameter static-space-start #x28000000)
- (defparameter dynamic-space-start #x30000000))
+(def!constant dynamic-1-space-start #x40000000)
+(def!constant dynamic-1-space-end #x4fff0000)
+
+(def!constant control-stack-start #x50000000)
+(def!constant control-stack-end #x51000000)
+
+(def!constant binding-stack-start #x70000000)
+(def!constant binding-stack-end #x71000000)
;;; FIXME nothing refers to either of these in alpha or x86 cmucl
LD = ld
LINKFLAGS = -g
NM = nm -gp
+DEPEND_FLAGS=-M
# The Config file is the preferred place for tweaking options which
# are appropriate for particular setups (OS, CPU, whatever). Make a
include Config
-SRCS = alloc.c backtrace.c breakpoint.c coreparse.c \
+C_SRCS =alloc.c backtrace.c breakpoint.c coreparse.c \
dynbind.c globals.c interr.c interrupt.c \
monitor.c parse.c print.c purify.c \
regnames.c run-program.c runtime.c save.c search.c \
- time.c util.c validate.c vars.c wrap.c \
- ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC}
+ time.c util.c validate.c vars.c wrap.c
+
+SRCS= $(C_SRCS) ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC}
OBJS = $(patsubst %.c,%.o,$(patsubst %.S,%.o,$(patsubst %.s,%.o,$(SRCS))))
clean:
rm -f depend *.o sbcl sbcl.nm core *.tmp ; true
-depend: ${SRCS} sbcl.h
- $(CC) -MM -E ${DEPEND_FLAGS} ${CFLAGS} ${CPPFLAGS} $^ > depend.tmp
+
+depend: ${C_SRCS} sbcl.h
+ $(CC) ${DEPEND_FLAGS} ${CFLAGS} ${CPPFLAGS} ${C_SRCS} > depend.tmp
mv -f depend.tmp depend
# By including this file, we cause GNU to automatically make depend if
static lispobj *
alloc(int bytes)
{
- lispobj *result;
+ char *result;
/* Round to dual word boundary. */
bytes = (bytes + LOWTAG_MASK) & ~LOWTAG_MASK;
- result = GET_FREE_POINTER();
+ result = (char *)GET_FREE_POINTER();
- SET_FREE_POINTER(result + (bytes / sizeof(lispobj)));
+ SET_FREE_POINTER((lispobj *)(result + bytes));
if (GET_GC_TRIGGER() && GET_FREE_POINTER() > GET_GC_TRIGGER()) {
SET_GC_TRIGGER((char *)GET_FREE_POINTER()
- (char *)current_dynamic_space);
}
- return result;
+ return (lispobj *) result;
}
#endif
-static lispobj *
+lispobj *
alloc_unboxed(int type, int words)
{
lispobj *result;
lispobj
alloc_sap(void *ptr)
{
- int n_words_to_alloc =
- (sizeof(struct sap) - sizeof(lispobj)) / sizeof(u32);
- struct sap *sap =
- (struct sap *)alloc_unboxed((int)SAP_WIDETAG, n_words_to_alloc);
+ struct sap *sap;
+ sap=(struct sap *)
+ alloc_unboxed((int)SAP_WIDETAG, sizeof(struct sap)/sizeof(lispobj) -1);
sap->pointer = ptr;
return (lispobj) sap | OTHER_POINTER_LOWTAG;
}
#include <stdio.h>
#include <string.h>
-#include <asm/pal.h> /* for PAL_gentrap */
#include "runtime.h"
#include "sbcl.h"
#include "monitor.h"
extern char call_into_lisp_LRA[], call_into_lisp_end[];
+
extern size_t os_vm_page_size;
#define BREAKPOINT_INST 0x80
+
void
arch_init(void)
{
/* This must be called _after_ os_init(), so that we know what the
* page size is. */
+
if (mmap((os_vm_address_t) call_into_lisp_LRA_page,os_vm_page_size,
OS_VM_PROT_ALL,MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED,-1,0)
== (os_vm_address_t) -1)
pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE))
return NULL;
- badinst = *pc;
-
- if (((badinst>>27)!=0x16) /* STL or STQ */
- && ((badinst>>27)!=0x13)) /* STS or STT */
- return NULL; /* Otherwise forget about address. */
-
- return (os_vm_address_t)
- (*os_context_register_addr(context,((badinst>>16)&0x1f))
- +(badinst&0xffff));
+ return context->uc_mcontext.sc_traparg_a0;
}
void
void arch_set_pseudo_atomic_interrupted(os_context_t *context)
{
/* On coming out of an atomic section, we subtract 1 from
- * reg_Alloc, then try to store something at that address. On
- * OSF/1 we add 1 to reg_Alloc here so that the end-of-atomic code
- * will raise SIGTRAP for "unaligned access". Linux catches
- * unaligned accesses in the kernel and fixes them up[1], so there
- * we toggle bit 63 instead. The resulting address is somewhere
- * out in no-man's land, so we get SIGSEGV when we try to access
- * it. We catch whichever signal it is (see the appropriate
- * *-os.c) and call interrupt_handle_pending() from it */
-
- /* [1] This behaviour can be changed with osf_setsysinfo, but cmucl
- * didn't use that */
-
-#ifdef __linux__
+ * reg_Alloc, then try to store something at that address. So,
+ * to signal that it was interrupted and a signal should be handled,
+ * we set bit 63 of reg_ALLOC here so that the end-of-atomic code
+ * will raise SIGSEGV (no ram mapped there). We catch the signal
+ * (see the appropriate *-os.c) and call interrupt_handle_pending()
+ * for the saved signal instead */
+
*os_context_register_addr(context,reg_ALLOC) |= (1L<<63);
-#else
- *os_context_register_addr(context,reg_ALLOC) |= 2;
-#endif
}
-/* XXX but is the caller of this storing all 64 bits? */
unsigned long arch_install_breakpoint(void *pc)
{
unsigned int *ptr = (unsigned int *)pc;
break;
default:
- fprintf(stderr, "unidetified breakpoint/trap %d\n",code);
+ fprintf(stderr, "unidentified breakpoint/trap %d\n",code);
interrupt_handle_now(signal, siginfo, context);
break;
}
#include "validate.h"
#include <alpha/regdef.h>
+#ifdef linux
#include <asm/pal.h>
-
+#else
+#include <alpha/pal.h>
+#endif
#include "sbcl.h"
#include "lispregs.h"
/* #include "globals.h" */
stl zero,foreign_function_call_active
/* Load lisp state. */
- ldl reg_ALLOC,dynamic_space_free_pointer
- ldl reg_BSP,current_binding_stack_pointer
- ldl reg_CSP,current_control_stack_pointer
- ldl reg_OCFP,current_control_frame_pointer
+ ldq reg_ALLOC,dynamic_space_free_pointer
+ ldq reg_BSP,current_binding_stack_pointer
+ ldq reg_CSP,current_control_stack_pointer
+ ldq reg_OCFP,current_control_frame_pointer
mov a1,reg_CFP
.set noat
/* Turn on pseudo-atomic. */
/* Save LISP registers */
- stl reg_ALLOC, dynamic_space_free_pointer
- stl reg_BSP,current_binding_stack_pointer
- stl reg_CSP,current_control_stack_pointer
- stl reg_CFP,current_control_frame_pointer
+ stq reg_ALLOC, dynamic_space_free_pointer
+ stq reg_BSP,current_binding_stack_pointer
+ stq reg_CSP,current_control_stack_pointer
+ stq reg_CFP,current_control_frame_pointer
/* Back in C land. [CSP is just a handy non-zero value.] */
stl reg_CSP,foreign_function_call_active
/* Save lisp state. */
subq reg_ALLOC,1,reg_L1
- stl reg_L1, dynamic_space_free_pointer
- stl reg_BSP, current_binding_stack_pointer
- stl reg_CSP, current_control_stack_pointer
- stl reg_CFP, current_control_frame_pointer
+ stq reg_L1, dynamic_space_free_pointer
+
+ stq reg_BSP, current_binding_stack_pointer
+ stq reg_CSP, current_control_stack_pointer
+ stq reg_CFP, current_control_frame_pointer
/* Mark us as in C land. */
stl reg_CSP, foreign_function_call_active
/* Into C land we go. */
- /* L1 is pv (procedure variable). The following line is */
- /* apparently a jump hint and not mysterious at all */
-
- /* <dhd> so, you have perfectly good code with comments written by */
- /* people who don't understand the Alpha :) */
-
- mov reg_CFUNC, reg_L1 /* ### This line is a mystery */
+ mov reg_CFUNC, reg_L1 /* L1=pv: this is a hint to the cache */
jsr ra, (reg_CFUNC)
ldgp $29,0(ra)
stl reg_ZERO, foreign_function_call_active
/* Restore ALLOC, preserving pseudo-atomic-atomic */
- ldl reg_NL0,dynamic_space_free_pointer
+ ldq reg_NL0,dynamic_space_free_pointer
addq reg_ALLOC,reg_NL0,reg_ALLOC
/* Check for interrupt */
* INTERNAL-ERROR function
*/
.text
- .globl undefined_tramp
+ .globl start_of_tramps
+ .globl closure_tramp
+ .globl undefined_tramp
+ .globl closure_tramp_offset
+ .globl undefined_tramp_offset
.ent undefined_tramp_offset
-undefined_tramp = /* ### undefined_tramp_offset-call_into_lisp_LRA*/ 0x140+call_into_lisp_LRA_page
undefined_tramp_offset:
+ /* an explanation is called for here. 0x140 is the difference
+ * between undefined_tramp_offset and call_into_lisp_LRA, but
+ * the assembler is too dumb to allow that as an expression.
+ * So, change this number whenever you add or remove any code
+ * in this file */
+
+undefined_tramp= call_into_lisp_LRA_page+0x140
call_pal PAL_bugchk
.long trap_Error
.byte 4 /* what are these numbers? */
.byte (0xe0 + sc_DescriptorReg)
.byte 2
.align 2
- .end undefined_tramp
+ .end undefined_tramp_offset
-/*
- * The closure trampoline.
- */
+/* The closure trampoline. */
.text
.globl closure_tramp
.ent closure_tramp_offset
-closure_tramp = /* ### */ 0x150 + call_into_lisp_LRA_page
+closure_tramp= call_into_lisp_LRA_page+0x150
closure_tramp_offset:
ldl reg_LEXENV, FDEFN_FUN_OFFSET(reg_FDEFN)
ldl reg_L0, CLOSURE_FUN_OFFSET(reg_LEXENV)
addl reg_L0, SIMPLE_FUN_CODE_OFFSET, reg_LIP
jmp reg_ZERO,(reg_LIP)
- .end closure_tramp
+ .end closure_tramp_offset
.text
.globl end_of_tramps
.globl fun_end_breakpoint_end
fun_end_breakpoint_end:
-
#define NREGS (32)
#ifdef LANGUAGE_ASSEMBLY
+#ifdef linux
#define REG(num) $##num
#else
+#define REG(num) $/**/num
+#endif /* linux */
+#else
#define REG(num) num
#endif
/* "traditional" register name and use */
#include "interr.h"
/* So you need to debug? */
-#if 0
#define PRINTNOISE
+#if 0
#define DEBUG_SPACE_PREDICATES
#define DEBUG_SCAVENGE_VERBOSE
#define DEBUG_COPY_VERBOSE
void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
{
- os_vm_address_t addr=(os_vm_address_t)current_dynamic_space +
- dynamic_usage;
- long length =
- DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
+ os_vm_address_t addr=(os_vm_address_t)current_dynamic_space
+ + dynamic_usage;
+
+ long length = DYNAMIC_SPACE_SIZE - dynamic_usage;
if (addr < (os_vm_address_t)dynamic_space_free_pointer) {
fprintf(stderr,
(unsigned int)dynamic_usage,
(os_vm_address_t)dynamic_space_free_pointer
- (os_vm_address_t)current_dynamic_space);
- return;
+ lose("lost");
}
else if (length < 0) {
fprintf(stderr,
"set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n",
dynamic_usage);
- return;
+ lose("lost");
}
addr=os_round_up_to_page(addr);
#endif
#endif
+/* FIXME : these sizes are, incidentally, bogus on Alpha. But the
+ * EXTERN macro doesn't use its second arg anyway, so no immediate harm
+ * done -dan 2002.05.07
+ */
+
EXTERN(foreign_function_call_active, 4)
EXTERN(current_control_stack_pointer, 4)
#include "dynbind.h"
#include "interr.h"
+
void sigaddset_blockable(sigset_t *s)
{
sigaddset(s, SIGHUP);
arch_set_pseudo_atomic_interrupted(context);
}
else {
+ lispobj *old_free_space=current_dynamic_space;
fake_foreign_function_call(context);
funcall0(SymbolFunction(MAYBE_GC));
undo_fake_foreign_function_call(context);
- }
-
+ if(current_dynamic_space==old_free_space)
+ /* MAYBE-GC (as the name suggest) might not. If it
+ * doesn't, it won't reset the GC trigger either, so we
+ * have to do it ourselves. Add small amount of space
+ * to tide us over while GC is inhibited
+ */
+ set_auto_gc_trigger((u32)dynamic_space_free_pointer
+ -(u32)current_dynamic_space
+ +(u32)os_vm_page_size);
+ }
return 1;
} else {
return 0;
* provided with absolutely no warranty. See the COPYING and CREDITS
* files for more information.
*/
-
- .file "ldso-stubs.S"
- .version "01.01"
-gcc2_compiled.:
+#include "sbcl.h"
.text
-#if defined __i386__
+#if defined LISP_FEATURE_X86
#define LDSO_STUBIFY(fct) \
.align 16 ; \
.L ## fct ## e1: ; \
.size ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;
-#elif defined alpha
+#elif ((defined LISP_FEATURE_OSF1) && (defined LISP_FEATURE_ALPHA))
+/* osf1 has ancient cpp that doesn't do ## */
+#define LDSO_STUBIFY(fct) \
+.globl ldso_stub__/**/fct ; \
+ldso_stub__/**/fct: ; \
+ jmp fct ; \
+.L/**/fct/**/e1: ;
+
+
+#elif ((defined LISP_FEATURE_LINUX) && (defined LISP_FEATURE_ALPHA))
+/* but there's no reason we need to put up with that on modern (Linux) OSes */
#define LDSO_STUBIFY(fct) \
.globl ldso_stub__ ## fct ; \
.type ldso_stub__ ## fct,@function ; \
.L ## fct ## e1: ; \
.size ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;
-#elif defined ppc
+#elif defined LISP_FEATURE_PPC
#define LDSO_STUBIFY(fct) \
.globl ldso_stub__ ## fct ; \
.type ldso_stub__ ## fct,@function ; \
.L ## fct ## e1: ; \
.size ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;
-#elif defined sparc
+#elif defined LISP_FEATURE_SPARC
/* This is an attempt to follow DB's hint of sbcl-devel
* 2001-09-18. -- CSR */
if (addr != NULL &&
*os_context_register_addr(context,reg_ALLOC) & (1L<<63)){
+
/* This is the end of a pseudo-atomic section during which
* a signal was received. We must deal with the pending interrupt
* (see also interrupt.c, ../code/interrupt.lisp)
*/
-
/* (how we got here: when interrupting, we set bit 63 in
* reg_Alloc. At the end of the atomic section we tried to
- * write to reg_Alloc, got a SIGSEGV (there's nothing mapped
+ * write to reg_ALLOC, got a SIGSEGV (there's nothing mapped
* there) so ended up here
*/
*os_context_register_addr(context,reg_ALLOC) -= (1L<<63);
* handler, i.e. the actual type of the thing pointed to by the
* void* third argument of a handler */
-/*
- #if defined __FreeBSD__
- #include "bsd-os.h"
- #elif defined __OpenBSD__
- #include "bsd-os.h"
- #elif defined __linux__
- #include "linux-os.h"
- #else
- #error unsupported OS
- #endif
-*/
-
#include "target-os.h"
* that SBCL runs on as of 0.6.7. If we port to the Alpha or some
* other non-32-bit machine we'll probably need real machine-dependent
* and OS-dependent definitions again. */
-#if ((defined alpha) && !(defined __linux__))
-#error No u32,s32 definitions for this platform. Write some.
-#else
-/* int happens to be 4 bytes on linux/alpha. long is longer. */
+/* even on alpha, int happens to be 4 bytes. long is longer. */
typedef unsigned int u32;
typedef signed int s32;
#define LOW_WORD(c) ((long)(c) & 0xFFFFFFFFL)
-#endif
+
typedef u32 lispobj;
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.4.16"
+"0.7.4.17"
projects / sbcl.git / commitdiff