Skip to content
Snippets Groups Projects
Commit f9e00564 authored by hallgren's avatar hallgren
Browse files

Initial revision

parent 6f4a04e5
No related branches found
No related tags found
No related merge requests found
CPPFLAGS = -I. -I/usr/hallgren/lib/gcc-lib/alpha-dec-osf1/2.4.5/include \
-I/usr/include -I/usr/misc/.X11/include
CC = gcc # -Wall -Wstrict-prototypes -Wmissing-prototypes
LD = ld
CPP = cpp
CFLAGS = -Dosf1 -Dalpha
ASFLAGS = -g -Dosf1 -Dalpha
NM = alpha-nm
UNDEFSYMPATTERN=-Xlinker -u -Xlinker &
ASSEM_SRC = alpha-assem.S
ARCH_SRC = alpha-arch.c
OS_SRC = osf1-os.c os-common.c
OS_LINK_FLAGS=-static
OS_LIBS=
#include <stdio.h>
#include "lisp.h"
#include "globals.h"
#include "validate.h"
#include "os.h"
#include "internals.h"
#include "arch.h"
#include "lispregs.h"
#include "signal.h"
#include "alloc.h"
#include "interrupt.h"
#include "interr.h"
#include "breakpoint.h"
extern char call_into_lisp_LRA[], call_into_lisp_end[];
char *arch_init(void)
{
if(mmap((os_vm_address_t) call_into_lisp_LRA_page,OS_VM_DEFAULT_PAGESIZE,
OS_VM_PROT_ALL,MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED,-1,0)
== (os_vm_address_t) -1)
perror("mmap");
bcopy(call_into_lisp_LRA,call_into_lisp_LRA_page,OS_VM_DEFAULT_PAGESIZE);
os_flush_icache(call_into_lisp_LRA_page,OS_VM_DEFAULT_PAGESIZE);
return NULL;
}
os_vm_address_t arch_get_bad_addr(int sig, int code, struct sigcontext *scp)
{
unsigned int badinst;
if((scp->sc_pc & 3) != 0) return NULL;
if( (scp->sc_pc < READ_ONLY_SPACE_START ||
scp->sc_pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) &&
((lispobj *)scp->sc_pc < current_dynamic_space ||
(lispobj *)scp->sc_pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE))
return NULL;
badinst = *(unsigned int *)scp->sc_pc;
if((badinst>>27)!=0x16) return NULL;
return scp->sc_regs[(badinst>>16)&0x1f] + (badinst&0xffff);
}
void arch_skip_instruction(scp)
struct sigcontext *scp;
{
}
unsigned char *arch_internal_error_arguments(struct sigcontext *scp)
{
return (unsigned char *)(scp->sc_pc+4);
}
boolean arch_pseudo_atomic_atomic(struct sigcontext *scp)
{
return (scp->sc_regs[reg_ALLOC] & 1);
}
#define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000
void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp)
{
scp->sc_regs[reg_ALLOC] |= 2;
}
unsigned long arch_install_breakpoint(void *pc)
{
}
void arch_remove_breakpoint(void *pc, unsigned long orig_inst)
{
}
static unsigned long *skipped_break_addr, displaced_after_inst;
static int orig_sigmask;
void arch_do_displaced_inst(struct sigcontext *scp,
unsigned long orig_inst)
{
}
static void sigtrap_handler(int signal, int code, struct sigcontext *scp)
{
/* Don't disallow recursive breakpoint traps. Otherwise, we can't */
/* use debugger breakpoints anywhere in here. */
sigsetmask(scp->sc_mask);
code=*(u32 *)(scp->sc_pc);
switch (code) {
case trap_PendingInterrupt:
arch_skip_instruction(scp);
interrupt_handle_pending(scp);
break;
case trap_Halt:
fake_foreign_function_call(scp);
lose("%%primitive halt called; the party is over.\n");
case trap_Error:
case trap_Cerror:
interrupt_internal_error(signal, code, scp, code==trap_Cerror);
break;
case trap_Breakpoint:
handle_breakpoint(signal, code, scp);
break;
case trap_FunctionEndBreakpoint:
scp->sc_pc = (int)handle_function_end_breakpoint(signal, code, scp);
break;
/*
case trap_AfterBreakpoint:
*skipped_break_addr = (trap_Breakpoint << 16) | 0xd;
os_flush_icache((os_vm_address_t)skipped_break_addr,
sizeof(unsigned long));
skipped_break_addr = NULL;
*(unsigned long *)scp->sc_pc = displaced_after_inst;
os_flush_icache((os_vm_address_t)scp->sc_pc, sizeof(unsigned long));
scp->sc_mask = orig_sigmask;
break;
*/
default:
interrupt_handle_now(signal, code, scp);
break;
}
}
#define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2)
static void sigfpe_handler(int signal, int code, struct sigcontext *scp)
{
}
void arch_install_interrupt_handlers()
{
interrupt_install_low_level_handler(SIGILL,sigtrap_handler);
interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler);
interrupt_install_low_level_handler(SIGFPE,sigfpe_handler);
}
extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
lispobj funcall0(lispobj function)
{
lispobj *args = current_control_stack_pointer;
return call_into_lisp(function, args, 0);
}
lispobj funcall1(lispobj function, lispobj arg0)
{
lispobj *args = current_control_stack_pointer;
current_control_stack_pointer += 1;
args[0] = arg0;
return call_into_lisp(function, args, 1);
}
lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1)
{
lispobj *args = current_control_stack_pointer;
current_control_stack_pointer += 2;
args[0] = arg0;
args[1] = arg1;
return call_into_lisp(function, args, 2);
}
lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
{
lispobj *args = current_control_stack_pointer;
current_control_stack_pointer += 3;
args[0] = arg0;
args[1] = arg1;
args[2] = arg2;
return call_into_lisp(function, args, 3);
}
/* This is apparently called by emulate_branch, but isn't defined. So */
/* just do nothing and hope it works... */
void cacheflush(void)
{
}
/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alpha-assem.S,v 1.1 1994/03/27 15:29:25 hallgren Exp $ */
#include <machine/regdef.h>
#include <machine/pal.h>
#include "internals.h"
#include "lispregs.h"
/*
* Function to transfer control into lisp.
*/
.text
.align 4
.globl call_into_lisp
.ent call_into_lisp
call_into_lisp:
#define framesize 8*8
ldgp gp, 0($27) /* ### */
/* Save all the C regs. */
lda sp,-framesize(sp)
stq ra, framesize-8*8(sp)
stq s0, framesize-8*7(sp)
stq s1, framesize-8*6(sp)
stq s2, framesize-8*5(sp)
stq s3, framesize-8*4(sp)
stq s4, framesize-8*3(sp)
stq s5, framesize-8*2(sp)
stq s6, framesize-8*1(sp)
.mask 0x0fc001fe, -framesize
.frame sp,framesize,ra
/* Clear descriptor regs */
ldil reg_CODE,0
ldil reg_FDEFN,0
mov a0,reg_LEXENV
sll a2,2,reg_NARGS
ldil reg_OCFP,0
ldil reg_LRA,0
ldil reg_L0,0
ldil reg_L1,0
/* Establish NIL. */
ldil reg_NULL,NIL
/* Start pseudo-atomic. */
/* No longer in foreign call. */
stl zero,foreign_function_call_active
/* Load lisp state. */
ldl reg_ALLOC,current_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
mov a1,reg_CFP
.set noat
ldil reg_L2,0
/* End of pseudo-atomic. */
/* Establish lisp arguments. */
ldl reg_A0,0(reg_CFP)
ldl reg_A1,4(reg_CFP)
ldl reg_A2,8(reg_CFP)
ldl reg_A3,12(reg_CFP)
ldl reg_A4,16(reg_CFP)
ldl reg_A5,20(reg_CFP)
/* Calculate the LRA. */
lda reg_LRA,call_into_lisp_LRA_page+type_OtherPointer
/* Indirect the closure */
ldl reg_CODE,CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
addl reg_CODE,6*4-type_FunctionPointer,reg_LIP
/* And into lisp we go. */
jsr reg_ZERO,(reg_LIP)
.set noreorder
.align 3
.globl call_into_lisp_LRA
call_into_lisp_LRA:
.word type_ReturnPcHeader
mov reg_OCFP,reg_CSP
nop
/* return value already there */
mov reg_A0,v0
/* Turn on pseudo-atomic. */
/* Save LISP registers */
stl reg_ALLOC,current_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
/* Back in C land. [CSP is just a handy non-zero value.] */
stl reg_CSP,foreign_function_call_active
/* Turn off pseudo-atomic and check for traps. */
/* Restore C regs */
ldq ra, framesize-8*8(sp)
ldq s0, framesize-8*7(sp)
ldq s1, framesize-8*6(sp)
ldq s2, framesize-8*5(sp)
ldq s3, framesize-8*4(sp)
ldq s4, framesize-8*3(sp)
ldq s5, framesize-8*2(sp)
ldq s6, framesize-8*1(sp)
ret zero,(ra),1
.globl call_into_lisp_end
call_into_lisp_end:
.end call_into_lisp
/*
* Transfering control from Lisp into C
*/
.set noreorder
.text
.align 4
.globl call_into_c
.ent call_into_c
call_into_c:
.mask 0x0fc001fe, -12
.frame sp,12,ra
mov reg_CFP, reg_OCFP
mov reg_CSP, reg_CFP
addq reg_CFP, 32, reg_CSP
stl reg_OCFP, 0(reg_CFP)
subl reg_LIP, reg_CODE, reg_L1
addl reg_L1, type_OtherPointer, reg_L1
stl reg_L1, 4(reg_CFP)
stl reg_CODE, 8(reg_CFP)
stl reg_NULL, 12(reg_CFP)
/* Set the pseudo-atomic flag. */
addq reg_ALLOC,1,reg_ALLOC
/* Get the top two register args and fix the NSP to point to arg 7 */
ldq reg_NL4,0(reg_NSP)
ldq reg_NL5,8(reg_NSP)
addq reg_NSP,16,reg_NSP
/* Save lisp state. */
subq reg_ALLOC,1,reg_L1
stl reg_L1, current_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
/* Mark us as in C land. */
stl reg_CSP, foreign_function_call_active
/* Were we interrupted? */
subq reg_ALLOC,1,reg_ALLOC
stl reg_ZERO,0(reg_ALLOC)
/* Into C land we go. */
jsr ra, (reg_CFUNC)
ldgp $29,0(ra)
/* restore NSP */
subq reg_NSP,16,reg_NSP
/* Clear unsaved descriptor regs */
mov reg_ZERO, reg_NARGS
mov reg_ZERO, reg_A0
mov reg_ZERO, reg_A1
mov reg_ZERO, reg_A2
mov reg_ZERO, reg_A3
mov reg_ZERO, reg_A4
mov reg_ZERO, reg_A5
mov reg_ZERO, reg_L0
mov reg_ZERO, reg_L2
/* Turn on pseudo-atomic. */
lda reg_ALLOC,1(reg_ZERO)
/* Mark us at in Lisp land. */
stl reg_ZERO, foreign_function_call_active
/* Restore ALLOC, preserving pseudo-atomic-atomic */
ldl reg_NL0,current_dynamic_space_free_pointer
addq reg_ALLOC,reg_NL0,reg_ALLOC
/* Check for interrupt */
subq reg_ALLOC,1,reg_ALLOC
stl reg_ZERO,0(reg_ALLOC)
ldl reg_NULL, 12(reg_CFP)
/* Restore LRA & CODE (they may have been GC'ed) */
ldl reg_CODE, 8(reg_CFP)
ldl reg_NL0, 4(reg_CFP)
subq reg_NL0, type_OtherPointer, reg_NL0
addq reg_CODE, reg_NL0, reg_NL0
mov reg_CFP, reg_CSP
mov reg_OCFP, reg_CFP
ret zero, (reg_NL0), 1
.end call_into_c
.text
.globl start_of_tramps
start_of_tramps:
/*
* The undefined-function trampoline.
*/
.text
.globl undefined_tramp
.ent undefined_tramp_offset
undefined_tramp = /* ### undefined_tramp_offset-call_into_lisp_LRA*/ 0x140+call_into_lisp_LRA_page
undefined_tramp_offset:
call_pal PAL_gentrap
.long 10
.byte 4
.byte 23
.byte 254
.byte 238
.byte 2
.align 2
.end undefined_tramp
/*
* The closure trampoline.
*/
.text
.globl closure_tramp
.ent closure_tramp_offset
closure_tramp = /* ### */ 0x150 + call_into_lisp_LRA_page
closure_tramp_offset:
ldl reg_LEXENV, FDEFN_FUNCTION_OFFSET(reg_FDEFN)
ldl reg_L0, CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
addl reg_L0, FUNCTION_CODE_OFFSET, reg_LIP
jmp reg_ZERO,(reg_LIP)
.end closure_tramp
.text
.globl end_of_tramps
end_of_tramps:
/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alpha-lispregs.h,v 1.1 1994/03/27 15:29:34 hallgren Exp $ */
#define NREGS (32)
#ifdef LANGUAGE_ASSEMBLY
#define REG(num) $ ## num
#else
#define REG(num) num
#endif
#define reg_LIP REG(0)
#define reg_A0 REG(1)
#define reg_A1 REG(2)
#define reg_A2 REG(3)
#define reg_A3 REG(4)
#define reg_A4 REG(5)
#define reg_A5 REG(6)
#define reg_L0 REG(7)
#define reg_NARGS REG(8)
#define reg_CSP REG(9)
#define reg_CFP REG(10)
#define reg_OCFP REG(11)
#define reg_BSP REG(12)
#define reg_LEXENV REG(13)
#define reg_CODE REG(14)
#define reg_NULL REG(15)
#define reg_NL0 REG(16)
#define reg_NL1 REG(17)
#define reg_NL2 REG(18)
#define reg_NL3 REG(19)
#define reg_NL4 REG(20)
#define reg_NL5 REG(21)
#define reg_ALLOC REG(22)
#define reg_FDEFN REG(23)
#define reg_CFUNC REG(24)
#define reg_NFP REG(25)
#define reg_LRA REG(26)
#define reg_L1 REG(27)
#define reg_L2 REG(28)
#define reg_GP REG(29)
#define reg_NSP REG(30)
#define reg_ZERO REG(31)
#define REGNAMES \
"LIP", "NL0", "NL1", "NL2", "NL3", "NL4", "NL5", "L0", "NARGS", \
"CSP", "CFP", "OCFP", "BSP", "LEXENV", "CODE", "FDEFN", "A0", "A1", \
"A2", "A3", "A4", "A5", "ALLOC", "NULL", "CFUNC", "NFP", "LRA", "L1", \
"L2", "GP", "NSP", "ZERO"
#define BOXED_REGISTERS { \
reg_CODE, reg_FDEFN, reg_LEXENV, reg_NARGS, reg_OCFP, reg_LRA, \
reg_A0, reg_A1, reg_A2, reg_A3, reg_A4, reg_A5, \
reg_L0, reg_L1, reg_L2 \
}
#define SC_REG(sc, n) ((sc)->sc_regs[n])
#define SC_PC(sc) ((sc)->sc_pc)
#define call_into_lisp_LRA_page 0x10000
#!/bin/csh -f
/bin/nm -Bgp $argv | sed "s/ U/0000000000000000 U/g"
exit 0
#define READ_ONLY_SPACE_START (0x20000000)
#define READ_ONLY_SPACE_SIZE (0x04000000)
#define STATIC_SPACE_START (0x28000000)
#define STATIC_SPACE_SIZE (0x04000000)
#define DYNAMIC_0_SPACE_START (0x30000000)
#define DYNAMIC_1_SPACE_START (0x38000000)
#define DYNAMIC_SPACE_SIZE (0x04000000)
#define CONTROL_STACK_START (0x50000000)
#define CONTROL_STACK_SIZE (0x00100000)
#define BINDING_STACK_START (0x70000000)
#define BINDING_STACK_SIZE (0x00100000)
/*
* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/osf1-os.c,v 1.1 1994/03/27 15:30:51 hallgren Exp $
*
* OS-dependent routines. This file (along with os.h) exports an
* OS-independent interface to the operating system VM facilities.
* Suprisingly, this interface looks a lot like the Mach interface
* (but simpler in some places). For some operating systems, a subset
* of these functions will have to be emulated.
*
* This is the OSF1 version. By Sean Hallgren.
*
*/
#include <stdio.h>
#include <sys/file.h>
#include <errno.h>
#include "./signal.h"
#include "os.h"
#include "arch.h"
#include "interrupt.h"
#include "lispregs.h"
#include <sys/types.h>
#include <sys/sysinfo.h>
#include <sys/proc.h>
vm_size_t os_vm_page_size;
void
os_init()
{
int buf[2] = {SSIN_UACPROC, UAC_SIGBUS|UAC_NOPRINT};
int error;
os_vm_page_size=OS_VM_DEFAULT_PAGESIZE;
if(setsysinfo(SSI_NVPAIRS,buf,1,NULL,NULL)==-1)
perror("setsysinfo");
}
os_vm_address_t
os_validate(os_vm_address_t addr, os_vm_size_t len)
{
int flags = MAP_PRIVATE|MAP_ANONYMOUS;
if(addr) flags|=MAP_FIXED;
else flags|=MAP_VARIABLE;
if((addr=mmap(addr,len,OS_VM_PROT_ALL,flags,-1,0)) == (os_vm_address_t) -1)
perror("mmap");
return addr;
}
void
os_invalidate(os_vm_address_t addr, os_vm_size_t len)
{
if(munmap(addr,len) == -1)
perror("munmap");
}
os_vm_address_t
os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
{
if((addr=mmap(addr,len,OS_VM_PROT_ALL,MAP_PRIVATE|MAP_FILE|MAP_FIXED,fd,
(off_t) offset)) == (os_vm_address_t) -1)
perror("mmap");
return addr;
}
void
os_flush_icache(os_vm_address_t address, os_vm_size_t length)
{
}
void
os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
{
if(mprotect(address, length, prot) == -1)
perror("mprotect");
}
boolean
valid_addr(os_vm_address_t addr)
{
int ret;
os_vm_address_t newaddr;
newaddr=os_trunc_to_page(addr);
if((ret=mvalid(newaddr,newaddr-addr+4,OS_VM_PROT_ALL)) == 0)
return TRUE;
else if(errno==EINVAL)
perror("mvalid");
return FALSE;
}
static void
sigbus_handler(int signal, int code, struct sigcontext *context)
{
context->sc_pc -= 4; /* pc is +4 on bus error!?!!? */
if(arch_get_bad_addr(signal,code,context) &&
context->sc_regs[reg_ALLOC] & 2) {
context->sc_regs[reg_ALLOC] -= 2;
interrupt_handle_pending(context);
} else
interrupt_handle_now(signal,code,context);
}
static void
sigsegv_handler(int signal, int code, struct sigcontext *context)
{
if(!interrupt_maybe_gc(signal, code, context))
interrupt_handle_now(signal, code, context);
}
void
os_install_interrupt_handlers(void)
{
interrupt_install_low_level_handler(SIGSEGV,sigsegv_handler);
interrupt_install_low_level_handler(SIGBUS,sigbus_handler);
}
#include <sys/types.h>
#include <sys/mman.h>
typedef caddr_t os_vm_address_t;
typedef size_t os_vm_size_t;
typedef off_t os_vm_offset_t;
typedef int os_vm_prot_t;
#define OS_VM_PROT_READ PROT_READ
#define OS_VM_PROT_WRITE PROT_WRITE
#define OS_VM_PROT_EXECUTE PROT_EXEC
#define OS_VM_DEFAULT_PAGESIZE 8192
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