Skip to content
Snippets Groups Projects
Commit 387b6869 authored by wlott's avatar wlott
Browse files

Added support for the IBM PC/RT.

parent e4d93998
No related branches found
No related tags found
No related merge requests found
/* $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);
}
......
/* $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;
......
/*
* $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);
}
/*
* 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
......
/* $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
}
/* $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)
......
/* $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;
......
/* $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. */
......
/* $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
/* $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> ");
......
/* $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;
......
/* 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);
......
/* $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
};
......@@ -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
}
......
/* $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
......
/* $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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment