diff --git a/ldb/alloc.c b/ldb/alloc.c index ec58c4a11a59ad4a365066672372394235912c4e..902c88db4b34194cf3bd4177c36457d18b64225d 100644 --- a/ldb/alloc.c +++ b/ldb/alloc.c @@ -1,9 +1,20 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/alloc.c,v 1.5 1990/10/13 04:48:16 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/alloc.c,v 1.6 1991/02/16 00:59:03 wlott Exp $ */ #include "lisp.h" #include "ldb.h" #include "alloc.h" #include "globals.h" +#ifdef ibmrt +#define GET_FREE_POINTER() ((lispobj *)SymbolValue(ALLOCATION_POINTER)) +#define SET_FREE_POINTER(new_value) \ + (SetSymbolValue(ALLOCATION_POINTER,(lispobj)(new_value))) +#else +#define GET_FREE_POINTER() current_dynamic_space_free_pointer +#define SET_FREE_POINTER(new_value) \ + (current_dynamic_space_free_pointer = (new_value)) +#endif + + /**************************************************************** Allocation Routines. @@ -17,14 +28,14 @@ int bytes; /* Round to dual word boundry. */ bytes = (bytes + lowtag_Mask) & ~lowtag_Mask; - result = current_dynamic_space_free_pointer; - current_dynamic_space_free_pointer += (bytes / sizeof(lispobj)); + result = GET_FREE_POINTER(); + SET_FREE_POINTER(result + (bytes / sizeof(lispobj))); if (current_auto_gc_trigger && - current_dynamic_space_free_pointer > current_auto_gc_trigger) { + GET_FREE_POINTER() > current_auto_gc_trigger) { /* We can't GC while in C land, so just dink the trigger. */ clear_auto_gc_trigger(); - set_auto_gc_trigger((char *)current_dynamic_space_free_pointer - + set_auto_gc_trigger((char *)GET_FREE_POINTER() - (char *)current_dynamic_space); } diff --git a/ldb/coreparse.c b/ldb/coreparse.c index 9bb0ccb71e0f06afc1a36fcdbfb1985a2edd69ec..0e06af31aad9f277354ca9239f16bb29554038b1 100644 --- a/ldb/coreparse.c +++ b/ldb/coreparse.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/coreparse.c,v 1.6 1990/10/22 12:26:54 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/coreparse.c,v 1.7 1991/02/16 00:59:39 wlott Exp $ */ #include <stdio.h> #include <mach.h> #include <sys/types.h> @@ -44,7 +44,11 @@ long *ptr; if (addr != (vm_address_t)dynamic_0_space && addr != (vm_address_t)dynamic_1_space) printf("Strange ... dynamic space lossage.\n"); current_dynamic_space = (lispobj *)addr; +#ifdef ibmrt + SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer); +#else current_dynamic_space_free_pointer = free_pointer; +#endif break; case STATIC_SPACE_ID: static_space = (lispobj *) addr; diff --git a/ldb/dynbind.c b/ldb/dynbind.c index f753121fb27107b957bcabcc6b71fea7963a42c1..40984eec38270f4bcb1735249470e9360b500da6 100644 --- a/ldb/dynbind.c +++ b/ldb/dynbind.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/dynbind.c,v 1.2 1990/03/29 21:13:23 ch Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/dynbind.c,v 1.3 1991/02/16 00:59:56 wlott Exp $ * * Support for dynamic binding from C. */ @@ -8,6 +8,14 @@ #include "lisp.h" #include "globals.h" +#ifdef ibmrt +#define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER)) +#define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value)) +#else +#define GetBSP() ((struct binding *)current_binding_stack_pointer) +#define SetBSP(value) (current_binding_stack_pointer=(lispobj *)(value)) +#endif + bind_variable(symbol, value) lispobj symbol, value; { @@ -15,8 +23,9 @@ lispobj symbol, value; struct binding *binding; old_value = SymbolValue(symbol); - binding = (struct binding *) current_binding_stack_pointer; - current_binding_stack_pointer += (sizeof(struct binding) / sizeof(lispobj)); + binding = GetBSP(); + SetBSP(binding+1); + binding->value = old_value; binding->symbol = symbol; SetSymbolValue(symbol, value); @@ -27,7 +36,7 @@ unbind() struct binding *binding; lispobj symbol; - binding = ((struct binding *) current_binding_stack_pointer) - 1; + binding = GetBSP() - 1; symbol = binding->symbol; @@ -35,26 +44,26 @@ unbind() binding->symbol = 0; - current_binding_stack_pointer -= (sizeof(struct binding) / sizeof(lispobj)); + SetBSP(binding); } unbind_to_here(bsp) lispobj *bsp; { - while (bsp > current_binding_stack_pointer) { - struct binding *binding; - lispobj symbol; + struct binding *target = (struct binding *)bsp; + struct binding *binding = GetBSP(); + lispobj symbol; - binding = ((struct binding *) current_binding_stack_pointer) - 1; - - symbol = binding->symbol; + while (target < binding) { + binding--; - if (symbol) { - SetSymbolValue(symbol, binding->value); - binding->symbol = 0; - } + symbol = binding->symbol; - current_binding_stack_pointer -= - (sizeof(struct binding) / sizeof(lispobj)); + if (symbol) { + SetSymbolValue(symbol, binding->value); + binding->symbol = 0; } + + } + SetBSP(binding); } diff --git a/ldb/gc.c b/ldb/gc.c index 8283789bf29e0001532cb9b8de3e4b1f0c4c9c20..9b11c783009cd9b6ceb991f9c80445231aaa3684 100644 --- a/ldb/gc.c +++ b/ldb/gc.c @@ -1,7 +1,7 @@ /* * Stop and Copy GC based on Cheney's algorithm. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/gc.c,v 1.24 1991/01/28 09:21:55 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/gc.c,v 1.25 1991/02/16 01:00:04 wlott Exp $ * * Written by Christopher Hoover. */ @@ -163,7 +163,11 @@ collect_garbage() /* Set up from space and new space pointers. */ from_space = current_dynamic_space; +#ifndef ibmrt from_space_free_pointer = current_dynamic_space_free_pointer; +#else + from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER); +#endif if (current_dynamic_space == dynamic_0_space) new_space = dynamic_1_space; @@ -201,7 +205,12 @@ collect_garbage() #endif scavenge(control_stack, control_stack_size); +#ifndef ibmrt binding_stack_size = current_binding_stack_pointer - binding_stack; +#else + binding_stack_size = + (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack; +#endif #ifdef PRINTNOISE printf("Scavenging the binding stack (%d bytes) ...\n", binding_stack_size * sizeof(lispobj)); @@ -244,7 +253,11 @@ collect_garbage() (os_vm_size_t) DYNAMIC_SPACE_SIZE); current_dynamic_space = new_space; +#ifndef ibmrt current_dynamic_space_free_pointer = new_space_free_pointer; +#else + SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer); +#endif #ifdef PRINTNOISE size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj); @@ -410,6 +423,12 @@ static int boxed_registers[] = { }; #endif +#ifdef ibmrt +static int boxed_registers[] = { + CODE, CNAME, LEXENV, LRA, A0, A1, A2 +}; +#endif + scavenge_interrupt_context(context) struct sigcontext *context; { @@ -470,10 +489,14 @@ struct sigcontext *context; /* Scanvenge all boxed registers in the context. */ for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { int index; +#if defined(DEBUG_SCAVENGE_REGISTERS) unsigned long reg; +#endif index = boxed_registers[i]; +#if defined(DEBUG_SCAVENGE_REGISTERS) reg = context->sc_regs[index]; +#endif scavenge((lispobj *) &(context->sc_regs[index]), 1); #if defined(DEBUG_SCAVENGE_REGISTERS) printf("Scavenged R%d: was 0x%08x now 0x%08x\n", @@ -680,11 +703,10 @@ struct code *code; while (fheaderl != NIL) { struct function_header *fheaderp, *nfheaderp; - lispobj nfheaderl, header; + lispobj nfheaderl; fheaderp = (struct function_header *) PTR(fheaderl); - header = fheaderp->header; - gc_assert(TypeOf(header) == type_FunctionHeader); + gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); /* calcuate the new function pointer and the new */ /* function header */ @@ -736,11 +758,8 @@ lispobj *where, object; /* code data block */ fheaderl = code->entry_points; while (fheaderl != NIL) { - lispobj header; - fheaderp = (struct function_header *) PTR(fheaderl); - header = fheaderp->header; - gc_assert(TypeOf(header) == type_FunctionHeader); + gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); #if defined(DEBUG_CODE_GC) printf("Scavenging boxed section of entry point located at 0x%08x.\n", @@ -1030,6 +1049,7 @@ lispobj object; { fprintf(stderr, "GC lossage. Trying to transport an immediate!?\n"); gc_lose(); + return NIL; } static @@ -1216,7 +1236,6 @@ lispobj object; { struct vector *vector; int length, nwords; - int subtype; gc_assert(Pointerp(object)); @@ -1623,7 +1642,6 @@ static lispobj trans_weak_pointer(object) lispobj object; { - int nwords; lispobj copy; struct weak_pointer *wp; @@ -1705,6 +1723,7 @@ lispobj object; fprintf(stderr, "GC lossage. No scavenge function for object 0x%08x\n", (unsigned long) object); gc_lose(); + return 0; } static lispobj @@ -1714,6 +1733,7 @@ lispobj object; fprintf(stderr, "GC lossage. No transport function for object 0x%08x\n", (unsigned long) object); gc_lose(); + return NIL; } static diff --git a/ldb/globals.c b/ldb/globals.c index af7af54389dfd495e2185261a2d88ee9c3001c35..9ab826fecd40d12af6d4224264c9be82bd613118 100644 --- a/ldb/globals.c +++ b/ldb/globals.c @@ -1,10 +1,11 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.c,v 1.6 1990/10/23 00:04:06 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.c,v 1.7 1991/02/16 01:00:19 wlott Exp $ */ /* Variables everybody needs to look at or frob on. */ #include <stdio.h> #include "lisp.h" +#include "ldb.h" #include "globals.h" char *number_stack_start; @@ -18,7 +19,9 @@ unsigned long current_flags_register; lispobj *current_control_stack_pointer; lispobj *current_control_frame_pointer; +#ifndef ibmrt lispobj *current_binding_stack_pointer; +#endif lispobj *read_only_space; lispobj *static_space; @@ -28,7 +31,9 @@ lispobj *control_stack; lispobj *binding_stack; lispobj *current_dynamic_space; +#ifndef ibmrt lispobj *current_dynamic_space_free_pointer; +#endif lispobj *current_auto_gc_trigger; globals_init() @@ -53,5 +58,7 @@ globals_init() /* Initialize the current lisp state. */ current_control_stack_pointer = control_stack; current_control_frame_pointer = (lispobj *)0; +#ifndef ibmrt current_binding_stack_pointer = binding_stack; +#endif } diff --git a/ldb/globals.h b/ldb/globals.h index b0e089b75c0604af498753015dbce5e5f637794a..0ee667af3c49d795c18a46f4cd62c0510bf86f1a 100644 --- a/ldb/globals.h +++ b/ldb/globals.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.h,v 1.6 1990/10/23 00:04:36 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.h,v 1.7 1991/02/16 01:00:22 wlott Exp $ */ #if !defined(_INCLUDE_GLOBALS_H_) #define _INCLUDED_GLOBALS_H_ @@ -18,7 +18,9 @@ extern unsigned long current_flags_register; extern lispobj *current_control_stack_pointer; extern lispobj *current_control_frame_pointer; +#ifndef ibmrt extern lispobj *current_binding_stack_pointer; +#endif extern lispobj *read_only_space; extern lispobj *static_space; @@ -28,7 +30,9 @@ extern lispobj *control_stack; extern lispobj *binding_stack; extern lispobj *current_dynamic_space; +#ifndef ibmrt extern lispobj *current_dynamic_space_free_pointer; +#endif extern lispobj *current_auto_gc_trigger; #else LANGUAGE_ASSEMBLY @@ -41,13 +45,19 @@ extern lispobj *current_auto_gc_trigger; #ifdef sparc #define EXTERN(name,bytes) .global _/**/name #endif +#ifdef ibmrt +#define EXTERN(name,bytes) .globl _/**/name +#endif + EXTERN(foreign_function_call_active, 4) -EXTERN(current_dynamic_space_free_pointer, 4) EXTERN(current_control_stack_pointer, 4) EXTERN(current_control_frame_pointer, 4) +#ifndef ibmrt EXTERN(current_binding_stack_pointer, 4) +EXTERN(current_dynamic_space_free_pointer, 4) +#endif #ifdef mips EXTERN(current_flags_register, 4) diff --git a/ldb/interrupt.c b/ldb/interrupt.c index b583c91649ff44ed3e023e5879d3a5a6f5e66c24..d043e83e124358f80a65faf1e1787b9298bfa09d 100644 --- a/ldb/interrupt.c +++ b/ldb/interrupt.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/interrupt.c,v 1.22 1991/01/28 12:58:16 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/interrupt.c,v 1.23 1991/02/16 01:00:26 wlott Exp $ */ /* Interrupt handing magic. */ @@ -42,8 +42,10 @@ static void fake_foreign_function_call(context) lispobj oldcont; /* Get current LISP state from context */ +#ifndef ibmrt current_dynamic_space_free_pointer = (lispobj *) context->sc_regs[ALLOC]; current_binding_stack_pointer = (lispobj *) context->sc_regs[BSP]; +#endif #ifdef mips current_flags_register = context->sc_regs[FLAGS]|(1<<flag_Atomic); #endif @@ -76,6 +78,7 @@ static void fake_foreign_function_call(context) oldcont = (lispobj)context->sc_regs[CFP]; current_control_stack_pointer = current_control_frame_pointer + 8; + current_control_frame_pointer[0] = oldcont; current_control_frame_pointer[1] = NIL; current_control_frame_pointer[2] = (lispobj)context->sc_regs[CODE]; @@ -116,9 +119,11 @@ static void undo_fake_foreign_function_call(context) /* ### Do I really need to unbind_to_here()? */ unbind(); +#ifndef ibmrt /* Put the dynamic space free pointer back into the context. */ context->sc_regs[ALLOC] = (unsigned long) current_dynamic_space_free_pointer; +#endif } #define call_maybe_gc() \ @@ -213,7 +218,6 @@ struct sigcontext *context; union interrupt_handler handler; lispobj *args; lispobj callname, function; - long mask; handler = interrupt_handlers[signal]; were_in_lisp = !foreign_function_call_active; @@ -229,6 +233,8 @@ struct sigcontext *context; /* Allow signals again. */ sigsetmask(context->sc_mask); + write(1, "Calling handler.\n", 17); + if (LowtagOf(handler.lisp) == type_EvenFixnum || LowtagOf(handler.lisp) == type_OddFixnum) (*handler.c)(signal, code, context); @@ -535,6 +541,12 @@ static boolean gc_trigger_hit(context) badaddr = (lispobj *)(context->sc_regs[rs1] + context->sc_regs[rs2]); } #endif + +#ifdef ibmrt + /* ### Don't know where to look on the RT. */ + badaddr = NULL; +#endif + return (badaddr >= current_auto_gc_trigger && badaddr < current_dynamic_space + DYNAMIC_SPACE_SIZE); } @@ -604,6 +616,10 @@ int (*handler)(); sv.sv_handler = sigemt_handler; else if (signal == SIGBUS) sv.sv_handler = sigbus_handler; +#endif +#ifdef ibmrt + if (0) + ; #endif else if (handler == SIG_DFL || handler == SIG_IGN) sv.sv_handler = handler; diff --git a/ldb/ldb.c b/ldb/ldb.c index f75a38be184bd971f8fdf36e51dfb88793ccd5db..9ded9d746b0191f19d8561e62c0b505fd1baa5c3 100644 --- a/ldb/ldb.c +++ b/ldb/ldb.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/ldb.c,v 1.10 1990/10/23 00:05:51 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/ldb.c,v 1.11 1991/02/16 01:00:31 wlott Exp $ */ /* Lisp kernel core debugger */ #include <stdio.h> @@ -87,6 +87,10 @@ char *envp[]; restore_state = load_core_file(core); +#ifdef ibmrt + SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack); +#endif + interrupt_init(); /* Convert the argv and envp to something Lisp can grok. */ diff --git a/ldb/lispregs.h b/ldb/lispregs.h index 1c36a037ccc1a4f516fb668f177d27f710031331..82f2b6f509fa964a5be566177ab4649d589c1135 100644 --- a/ldb/lispregs.h +++ b/ldb/lispregs.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/lispregs.h,v 1.6 1990/11/24 07:47:01 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/lispregs.h,v 1.7 1991/02/16 01:00:33 wlott Exp $ */ #ifdef LANGUAGE_ASSEMBLY #ifdef mips @@ -7,15 +7,17 @@ #ifdef sparc #define REG(num) %num #endif +#ifdef ibmrt +#define REG(num) r/**/num +#endif #else #define REG(num) num extern char *lisp_register_names[]; #endif -#define NREGS (32) - #ifdef mips +#define NREGS (32) #define ZERO REG(0) #define NL3 REG(1) #define NL4 REG(2) @@ -50,6 +52,7 @@ extern char *lisp_register_names[]; #ifdef sparc +#define NREGS (32) #define ZERO REG(0) #define ALLOC REG(1) #define NULLREG REG(2) @@ -82,3 +85,24 @@ extern char *lisp_register_names[]; #define CODE REG(29) #define LIP REG(31) #endif + + +#ifdef ibmrt +#define NREGS (16) +#define NARGS REG(0) +#define NSP REG(1) +#define NL0 REG(2) +#define OCFP REG(3) +#define NFP REG(4) +#define CSP REG(5) +#define CFP REG(6) +#define CODE REG(7) +#define NULLREG REG(8) +#define CNAME REG(9) +#define LEXENV REG(10) +#define LRA REG(11) +#define A0 REG(12) +#define A1 REG(13) +#define A2 REG(14) +#define LIP REG(15) +#endif diff --git a/ldb/monitor.c b/ldb/monitor.c index 86bb296eadc75268a0831a495cfec36a8c3c1721..6d7afa0ea153cade15c68a5875e2b6baef5bb99a 100644 --- a/ldb/monitor.c +++ b/ldb/monitor.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/monitor.c,v 1.13 1990/11/25 08:43:40 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/monitor.c,v 1.14 1991/02/16 01:00:36 wlott Exp $ */ #include <stdio.h> #include <setjmp.h> @@ -122,10 +122,14 @@ char **ptr; { printf("CSP\t=\t0x%08x\n", current_control_stack_pointer); printf("FP\t=\t0x%08x\n", current_control_frame_pointer); +#ifndef ibmrt printf("BSP\t=\t0x%08x\n", current_binding_stack_pointer); +#endif printf("DYNAMIC\t=\t0x%08x\n", current_dynamic_space); +#ifndef ibmrt printf("ALLOC\t=\t0x%08x\n", current_dynamic_space_free_pointer); +#endif printf("TRIGGER\t=\t0x%08x\n", current_auto_gc_trigger); printf("STATIC\t=\t0x%08x\n", SymbolValue(STATIC_SPACE_FREE_POINTER)); printf("RDONLY\t=\t0x%08x\n", SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); @@ -200,7 +204,7 @@ char **ptr; extern lispobj call_into_lisp(); lispobj call_name = parse_lispobj(ptr); - lispobj function, result, arg, *args; + lispobj function, result, *args; int numargs; if (LowtagOf(call_name) == type_OtherPointer) { @@ -253,7 +257,7 @@ char **ptr; lispobj args[16]; lispobj call_name = parse_lispobj(ptr); - lispobj function, result, arg, *argptr; + lispobj function, result, *argptr; int numargs; struct timeval start_tv, stop_tv; struct rusage start_rusage, stop_rusage; @@ -357,7 +361,7 @@ struct sigcontext *context; { int i; - for (i = 0; i < 32; i++) { + for (i = 0; i < NREGS; i++) { printf("%s:\t", lisp_register_names[i]); brief_print((lispobj) context->sc_regs[i]); } @@ -454,7 +458,6 @@ static void sub_monitor() struct cmd *cmd, *found; char *line, *ptr, *token; int ambig; - lispobj *new; while (!done) { printf("ldb> "); diff --git a/ldb/parse.c b/ldb/parse.c index 2191845210854a4eba83e7dbce6cb0dfa455aa9f..3c36b181ce30fa53c7ed35c802925730d37fa8dd 100644 --- a/ldb/parse.c +++ b/ldb/parse.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/parse.c,v 1.5 1990/08/30 16:38:11 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/parse.c,v 1.6 1991/02/16 01:00:41 wlott Exp $ */ #include <stdio.h> #include <ctype.h> #include <signal.h> @@ -238,7 +238,11 @@ lispobj *result; /* Search dynamic space */ *result = (lispobj) current_dynamic_space; +#ifndef ibmrt count = current_dynamic_space_free_pointer - current_dynamic_space; +#else + count = (lispobj *)SymbolValue(ALLOCATION_POINTER) - current_dynamic_space; +#endif if (search_for_symbol(name, result, &count)) { *result |= type_OtherPointer; return TRUE; diff --git a/ldb/purify.c b/ldb/purify.c index fb6f7c88464eae7d03aa56e0734d53601f9928d7..3dbf46a7dfd7b59c7695c60d84c937cb87458bb7 100644 --- a/ldb/purify.c +++ b/ldb/purify.c @@ -1,6 +1,6 @@ /* Purify. */ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/purify.c,v 1.11 1990/12/18 23:26:42 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/purify.c,v 1.12 1991/02/16 01:00:44 wlott Exp $ */ #include <mach.h> @@ -648,7 +648,7 @@ static lispobj *pscav(addr, nwords, constant) int purify(static_roots, read_only_roots) -lispobj static_roots; +lispobj static_roots, read_only_roots; { lispobj *clean; int count, i; @@ -695,7 +695,11 @@ lispobj static_roots; printf(" bindings"); fflush(stdout); #endif +#ifndef ibmrt pscav(binding_stack, current_binding_stack_pointer - binding_stack, FALSE); +#else + pscav(binding_stack, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack, FALSE); +#endif #ifdef PRINTNOISE printf(" static"); @@ -741,7 +745,11 @@ lispobj static_roots; ((current_control_stack_pointer - control_stack) * sizeof(lispobj)))); +#ifndef ibmrt current_dynamic_space_free_pointer = current_dynamic_space; +#else + SetSymbolValue(ALLOCATION_POINTER, (lispobj)current_dynamic_space); +#endif SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free); SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free); diff --git a/ldb/regnames.c b/ldb/regnames.c index 58fea05d7ee34db4cd67982ed4b1a82954d42154..9f0c295f5dae05caeb2c935d2fb70045b83178c6 100644 --- a/ldb/regnames.c +++ b/ldb/regnames.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/regnames.c,v 1.3 1990/10/23 00:02:53 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/regnames.c,v 1.4 1991/02/16 01:00:50 wlott Exp $ */ #include "lispregs.h" @@ -35,7 +35,7 @@ char *lisp_register_names[] = { "L2", "NSP", "CODE", - "LIP" + "LIP", #endif #ifdef sparc "ZERO", @@ -69,10 +69,25 @@ char *lisp_register_names[] = { "L2", "CODE", "???", - "LIP" + "LIP", #endif +#ifdef ibmrt + "NARGS", + "NSP", + "NL0", + "OCFP", + "NFP", + "CSP", + "CFP", + "CODE", + "NULL", + "CNAME", + "LEXENV", + "LRA", + "A0", + "A1", + "A2", + "LIP", +#endif + 0 }; - - - - diff --git a/ldb/save.c b/ldb/save.c index 72cf2e9d757eb0553037d88906cf8e4e972af4eb..8f7c6704ba037a0581bcf53c8208d9978ba3b41c 100644 --- a/ldb/save.c +++ b/ldb/save.c @@ -78,7 +78,7 @@ lispobj *addr, *end; static long write_stack(name, start, end) char *name, *start, *end; { - long data, len; + long len; start = (char *)trunc_page((vm_address_t)start); end = (char *)round_page((vm_address_t)end); @@ -93,8 +93,6 @@ char *name, *start, *end; static void output_machine_state(context) struct sigcontext *context; { - int data, stacklen; - char *stack; struct machine_state ms; putw(CORE_MACHINE_STATE, save_file); @@ -102,15 +100,25 @@ struct sigcontext *context; ms.csp = current_control_stack_pointer; ms.fp = current_control_frame_pointer; +#ifndef ibmrt ms.bsp = current_binding_stack_pointer; +#else + ms.bsp = (lispobj *)SymbolValue(BINDING_STACK_POINTER); +#endif ms.number_stack_start = number_stack_start; ms.sigcontext_page = write_bytes((char *)context, sizeof(struct sigcontext)); ms.control_stack_page = write_stack("Control", (char *)control_stack, (char *)current_control_stack_pointer); +#ifndef ibmrt ms.binding_stack_page = write_stack("Binding", (char *)binding_stack, (char *)current_binding_stack_pointer); +#else + ms.binding_stack_page = write_stack("Binding", + (char *)binding_stack, + (char *)SymbolValue(BINDING_STACK_POINTER)); +#endif ms.number_stack_page = write_stack("Number", (char *)(context->sc_regs[NSP]), number_stack_start); @@ -138,7 +146,12 @@ struct sigcontext *context; output_space(READ_ONLY_SPACE_ID, read_only_space, (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); output_space(STATIC_SPACE_ID, static_space, (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER)); +#ifndef ibmrt output_space(DYNAMIC_SPACE_ID, current_dynamic_space, current_dynamic_space_free_pointer); +#else + output_space(DYNAMIC_SPACE_ID, current_dynamic_space, (lispobj *)SymbolValue(ALLOCATION_POINTER)); +#endif + output_machine_state(context); @@ -236,7 +249,11 @@ struct machine_state *ms; { current_control_stack_pointer = ms->csp; current_control_frame_pointer = ms->fp; +#ifndef ibmrt current_binding_stack_pointer = ms->bsp; +#else + SetSymbolValue(BINDING_STACK_POINTER, (lispobj)ms->bsp); +#endif if (ms->number_stack_start > number_stack_start) { fprintf(stderr, "Your environment is too large. Use ``unsetenv''\n"); @@ -257,7 +274,11 @@ struct machine_state *ms; map_stack(fd, (vm_address_t)binding_stack, +#ifndef ibmrt (vm_address_t)current_binding_stack_pointer, +#else + (vm_address_t)SymbolValue(BINDING_STACK_POINTER), +#endif ms->binding_stack_page, "Binding"); @@ -274,8 +295,6 @@ struct sigcontext *old_context; { vm_size_t len; vm_address_t nsp; - kern_return_t res; - /* We have to move the number stack into place. */ nsp = trunc_page((vm_address_t)context.sc_regs[NSP]); @@ -287,9 +306,13 @@ struct sigcontext *old_context; vm_deallocate(task_self(), number_stack, round_page(len)); +#ifndef ibmrt sigreturn(&context); /* We should not get here. */ +#else + bcopy(&context, old_context, sizeof(context)); +#endif } diff --git a/ldb/test.c b/ldb/test.c index f72c8bfb6b7d426a6709841ef6da982f8e0c4da2..791003ea58bfe1137dee5759bea5bae812b47efa 100644 --- a/ldb/test.c +++ b/ldb/test.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/test.c,v 1.10 1990/11/24 07:52:32 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/test.c,v 1.11 1991/02/16 01:01:36 wlott Exp $ */ /* Extra random routines for testing stuff. */ #include <signal.h> @@ -46,6 +46,23 @@ static char *errors[] = ERRORS; #define double_float_reg_sc 20 #endif +#ifdef ibmrt +#define any_reg_sc 10 +#define descriptor_reg_sc 11 +#define base_char_reg_sc 12 +#define sap_reg_sc 13 +#define signed_reg_sc 14 +#define unsigned_reg_sc 15 +#define non_descr_reg_sc 16 +#define word_pointer_reg_sc 17 +#define interior_reg_sc 18 +#define single_68881_reg_sc 19 +#define double_68881_reg_sc 20 +#define single_fpa_reg_sc 21 +#define double_fpa_reg_sc 22 +#define single_afpa_reg_sc 23 +#define double_afpa_reg_sc 24 +#endif signal_handler(signal, code, context) int signal, code; @@ -63,8 +80,7 @@ struct sigcontext *context; ptr = (unsigned long *)(context->sc_pc + 4); else ptr = (unsigned long *)(context->sc_pc); -#endif -#ifdef sparc +#else ptr = (unsigned long *)(context->sc_pc); #endif @@ -82,6 +98,22 @@ struct sigcontext *context; #ifdef sparc if ((bad_inst & 0xc1c00000) == 0) { switch (bad_inst & 0x3fffff) { +#if 0 + } + } +#endif +#endif +#ifdef ibmrt + if ((bad_inst & 0xffff0000) == 0xcc700000) { + switch (bad_inst & 0xffff) { +#if 0 + } + } +#endif +#endif +#if !defined(mips) && !defined(sparc) && !defined(ibmrt) + if (0) { + switch (0) { #endif case trap_Halt: printf("%primitive halt called; the party is over.\n"); @@ -144,6 +176,9 @@ struct sigcontext *context; } break; case sap_reg_sc: +#ifdef ibmrt + case word_pointer_reg_sc: +#endif printf("\t0x%08x\n", context->sc_regs[offset]); break; case signed_reg_sc: @@ -156,6 +191,7 @@ struct sigcontext *context; case interior_reg_sc: printf("\t???\n"); break; +#ifndef ibmrt case single_float_reg_sc: printf("\t%g\n", *(float *)&context->sc_fpregs[offset]); @@ -164,6 +200,7 @@ struct sigcontext *context; printf("\t%g\n", *(double *)&context->sc_fpregs[offset]); break; +#endif default: printf("\t???\n"); break; @@ -202,7 +239,7 @@ struct sigcontext *context; test_init() { install_handler(SIGINT, signal_handler); -#ifdef mips +#if defined(mips)||defined(ibmrt) install_handler(SIGTRAP, signal_handler); #endif #ifdef sparc diff --git a/ldb/validate.h b/ldb/validate.h index ad1fd55ead1233a7624827c4b60b3e98abcd0fa9..0755dd1d257d434491828f2d7fb216b24b3bcd34 100644 --- a/ldb/validate.h +++ b/ldb/validate.h @@ -1,10 +1,10 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/validate.h,v 1.5 1990/12/05 11:04:49 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/validate.h,v 1.6 1991/02/16 01:01:39 wlott Exp $ */ #if !defined(_INCLUDE_VALIDATE_H_) #define _INCLUDE_VALIDATE_H_ -#define READ_ONLY_SPACE_START (0x01000000) -#define READ_ONLY_SPACE_SIZE (0x03000000) +#define READ_ONLY_SPACE_START (0x00100000) +#define READ_ONLY_SPACE_SIZE (0x03F00000) #define STATIC_SPACE_START (0x04000000) #define STATIC_SPACE_SIZE (0x02000000)