1.0.24.18: new HPUX specific files (6eab504b) · Commits · Christophe Rhodes / sbcl

src/code/hpux-os.lisp

0 → 100644

+43 −0

Original line number	Diff line number	Diff line
		;;;; OS interface functions for SBCL under HPUX

		;;;; This software is part of the SBCL system. See the README file for
		;;;; more information.
		;;;;
		;;;; This software is derived from the CMU CL system, which was
		;;;; written at Carnegie Mellon University and released into the
		;;;; public domain. The software is in the public domain and is
		;;;; provided with absolutely no warranty. See the COPYING and CREDITS
		;;;; files for more information.

		(in-package "SB!SYS")

		;;; Check that target machine features are set up consistently with
		;;; this file.
		#!-hpux (error "missing :HPUX feature")

		(defun software-type ()
		#!+sb-doc
		"Return a string describing the supporting software."
		(values "HPUX"))

		(defun software-version ()
		#!+sb-doc
		"Return a string describing version of the supporting software, or NIL
		if not available."
		(or software-version
		(setf software-version
		(string-trim '(#\newline)
		(with-output-to-string (stream)
		(sb!ext:run-program "/bin/uname" `("-r")
		:output stream))))))

		;;; Return system time, user time and number of page faults.
		(defun get-system-info ()
		(multiple-value-bind
		(err? utime stime maxrss ixrss idrss isrss minflt majflt)
		(sb!unix:unix-getrusage sb!unix:rusage_self)
		(declare (ignore maxrss ixrss idrss isrss minflt))
		(unless err? ; FIXME: nonmnemonic (reversed) name for ERR?
		(error "Unix system call getrusage failed: ~A." (strerror utime)))
		(values utime stime majflt)))

src/runtime/hppa-arch.c

+93 −31

Original line number	Diff line number	Diff line
		@@ -29,11 +29,17 @@ void arch_init(void)
		return;
		}

		static inline unsigned int
		os_context_pc(os_context_t *context)
		{
		return (unsigned int)(*os_context_pc_addr(context));
		}

		os_vm_address_t arch_get_bad_addr(int signal, siginfo_t siginfo, os_context_t context)
		{
		return siginfo->si_addr;
		return (os_vm_address_t)siginfo->si_addr;
		#if 0
		#ifdef hpux
		#ifdef LISP_FEATURE_HPUX
		struct save_state *state;
		os_vm_address_t addr;

		@@ -86,25 +92,41 @@ boolean arch_pseudo_atomic_atomic(os_context_t *context)
		* The foreign_function_call_active used to live at each call-site
		* to arch_pseudo_atomic_atomic, but this seems clearer.
		* --NS 2007-05-15 */
		return (!foreign_function_call_active)
		&& ((*os_context_register_addr(context,reg_ALLOC)) & 4);

		// FIX-lav: use accessor macro instead
		return (!foreign_function_call_active) &&
		(&((ucontext_t ) context)->uc_mcontext.ss_wide.ss_64.ss_gr7) & 4;
		}

		void arch_set_pseudo_atomic_interrupted(os_context_t *context)
		{
		*os_context_register_addr(context,reg_ALLOC) \|= 1;

		(&((ucontext_t ) context)->uc_mcontext.ss_wide.ss_64.ss_gr7) \|= 1;
		/* on hpux do we need to watch out for the barbarian ? */
		#ifdef LISP_FEATURE_HPUX
		((os_context_register_t ) &((ucontext_t *) context)->uc_mcontext.ss_flags)
		\|= SS_MODIFIEDWIDE;
		#endif
		}

		/* FIXME: untested */
		void arch_clear_pseudo_atomic_interrupted(os_context_t *context)
		{
		*os_context_register_addr(context,reg_ALLOC) &= ~1;
		(&((ucontext_t ) context)->uc_mcontext.ss_wide.ss_64.ss_gr7) &= ~1;
		#ifdef LISP_FEATURE_HPUX
		((os_context_register_t ) &((ucontext_t *) context)->uc_mcontext.ss_flags)
		\|= SS_MODIFIEDWIDE;
		#endif
		}

		void arch_skip_instruction(os_context_t *context)
		{
		((char ) os_context_pc_addr(context)) = ((char ) os_context_npc_addr(context));
		((char ) os_context_npc_addr(context)) += 4;
		((unsigned int ) os_context_pc_addr(context)) = ((unsigned int ) os_context_npc_addr(context));
		((unsigned int ) os_context_npc_addr(context)) += 4;
		#ifdef LISP_FEATURE_HPUX
		((os_context_register_t ) &((ucontext_t *) context)->uc_mcontext.ss_flags)
		\|= SS_MODIFIEDWIDE;
		#endif
		}

		unsigned int arch_install_breakpoint(void *pc)
		@@ -127,9 +149,10 @@ void arch_remove_breakpoint(void *pc, unsigned int orig_inst)

		void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
		{
		fprintf(stderr, "arch_do_displaced_inst() WARNING: stub.\n");
		/* FIXME: Fill this in */
		#if 0
		#ifdef hpux
		#ifdef LISP_FEATURE_HPUX
		/* We change the next-pc to point to a breakpoint instruction, restore */
		/* the original instruction, and exit. We would like to be able to */
		/* sigreturn, but we can't, because this is hpux. */
		@@ -156,7 +179,8 @@ void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
		#endif
		}

		#ifdef hpux
		#ifdef LISP_FEATURE_HPUX
		#if 0
		static void restore_breakpoint(struct sigcontext *scp)
		{
		/* We just single-stepped over an instruction that we want to replace */
		@@ -191,6 +215,9 @@ static void restore_breakpoint(struct sigcontext *scp)
		}
		}
		#endif
		#endif



		void
		arch_handle_breakpoint(os_context_t *context)
		@@ -208,6 +235,19 @@ arch_handle_fun_end_breakpoint(os_context_t *context)
		handle_fun_end_breakpoint(context);
		*os_context_pc_addr(context) = pc;
		*os_context_npc_addr(context) = pc + 4;
		((os_context_register_t ) &((ucontext_t *) context)->uc_mcontext.ss_flags)
		\|= SS_MODIFIEDWIDE;
		}


		//FIX-lav: this whole is copied from mips
		void
		arch_handle_single_step_trap(os_context_t *context, int trap)
		{
		unsigned int code = ((u32 )(os_context_pc(context)));
		int register_offset = code >> 11 & 0x1f;
		handle_single_step_trap(context, trap, register_offset);
		arch_skip_instruction(context);
		}

		static void
		@@ -216,17 +256,28 @@ sigtrap_handler(int signal, siginfo_t siginfo, void void_context)
		os_context_t *context = arch_os_get_context(&void_context);
		unsigned int bad_inst;

		#if 0
		printf("sigtrap_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh,
		SC_REG(scp,reg_ALLOC));
		#endif

		bad_inst = (unsigned int )(*os_context_pc_addr(context) & ~3);
		if (bad_inst & 0xfc001fe0)
		interrupt_handle_now(signal, siginfo, context);
		else {
		int im5 = bad_inst & 0x1f;
		handle_trap(context, trap);
		handle_trap(context, im5);
		}
		}

		static void
		sigill_handler(int signal, siginfo_t siginfo, void void_context)
		{
		os_context_t *context = arch_os_get_context(&void_context);
		unsigned int bad_inst;

		bad_inst = (unsigned int )(*os_context_pc_addr(context) & ~3);
		if (bad_inst == 9) { /* pending-interrupt */
		arch_clear_pseudo_atomic_interrupted(context);
		arch_skip_instruction(context);
		interrupt_handle_pending(context);
		} else {
		handle_trap(context,bad_inst);
		}
		}

		@@ -237,11 +288,6 @@ static void sigfpe_handler(int signal, siginfo_t siginfo, void void_context)
		int opcode, r1, r2, t;
		long op1, op2, res;

		#if 0
		printf("sigfpe_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh,
		SC_REG(scp,reg_ALLOC));
		#endif

		switch (siginfo->si_code) {
		case FPE_INTOVF: /I_OVFLO: /
		badinst = (unsigned int )(*os_context_pc_addr(context) & ~3);
		@@ -274,7 +320,7 @@ static void sigfpe_handler(int signal, siginfo_t siginfo, void void_context)
		/* Add or subtract immediate. */
		op1 = ((badinst >> 3) & 0xff) \| ((-badinst&1)<<8);
		r2 = (badinst >> 16) & 0x1f;
		op2 = fixnum_value(*os_context_register_addr(context, r1));
		op2 = fixnum_value(*os_context_register_addr(context, r2));
		t = (badinst >> 21) & 0x1f;
		if (opcode == 0x2d)
		res = op1 + op2;
		@@ -283,7 +329,6 @@ static void sigfpe_handler(int signal, siginfo_t siginfo, void void_context)
		}
		else
		goto not_interesting;

		/* ?? What happens here if we hit the end of dynamic space? */
		dynamic_space_free_pointer = (lispobj ) os_context_register_addr(context, reg_ALLOC);
		*os_context_register_addr(context, t) = alloc_number(res);
		@@ -292,15 +337,20 @@ static void sigfpe_handler(int signal, siginfo_t siginfo, void void_context)
		arch_skip_instruction(context);

		break;

		case 0: /* I_COND: ?? Maybe tagged add?? FIXME */
		//#ifdef LINUX
		// case 0:
		//#endif
		case FPE_COND:
		badinst = (unsigned int )(*os_context_pc_addr(context) & ~3);
		if ((badinst&0xfffff800) == (0xb000e000\|reg_ALLOC<<21\|reg_ALLOC<<16)) {
		/* It is an ADDIT,OD i,ALLOC,ALLOC instruction that trapped. */
		/* That means that it is the end of a pseudo-atomic. So do the */
		/* add stripping off the pseudo-atomic-interrupted bit, and then */
		/* tell the machine-independent code to process the pseudo- */
		/* atomic. */
		/* It is an ADDIT,OD i,ALLOC,ALLOC instruction that trapped.
		* That means that it is the end of a pseudo-atomic. So do the
		* add stripping off the pseudo-atomic-interrupted bit, and then
		* tell the machine-independent code to process the pseudo-
		* atomic. We cant skip the instruction because it holds
		* extra-bytes that we must add to reg_alloc in context.
		* It is so because we optimized away 'addi ,extra-bytes reg_alloc'
		*/
		int immed = (badinst>>1)&0x3ff;
		if (badinst & 1)
		immed \|= -1<<10;
		@@ -375,7 +425,7 @@ static void sigbus_handler(int signal, siginfo_t siginfo, void void_context)
		/* Add or subtract immediate. */
		op1 = ((badinst >> 3) & 0xff) \| ((-badinst&1)<<8);
		r2 = (badinst >> 16) & 0x1f;
		op2 = fixnum_value(*os_context_register_addr(context, r1));
		op2 = fixnum_value(*os_context_register_addr(context, r2));
		t = (badinst >> 21) & 0x1f;
		if (opcode == 0x2d)
		res = op1 + op2;
		@@ -399,11 +449,23 @@ static void sigbus_handler(int signal, siginfo_t siginfo, void void_context)
		}
		}

		static void
		ignore_handler(int signal, siginfo_t siginfo, void void_context)
		{
		}

		/* this routine installs interrupt handlers that will
		* bypass the lisp interrupt handlers */
		void arch_install_interrupt_handlers(void)
		{
		undoably_install_low_level_interrupt_handler(SIGTRAP,sigtrap_handler);
		undoably_install_low_level_interrupt_handler(SIGILL,sigill_handler);
		undoably_install_low_level_interrupt_handler(SIGFPE,sigfpe_handler);
		/* FIXME: beyond 2.4.19-pa4 this shouldn't be necessary. */
		undoably_install_low_level_interrupt_handler(SIGBUS,sigbus_handler);
		#ifdef LISP_FEATURE_HPUX
		undoably_install_low_level_interrupt_handler(SIGXCPU,ignore_handler);
		undoably_install_low_level_interrupt_handler(SIGXFSZ,ignore_handler);
		#endif
		}

src/runtime/hppa-assem.S

+125 −100

Original line number	Diff line number	Diff line
		@@ -2,18 +2,25 @@

		#include "sbcl.h"
		#include "lispregs.h"
		#include "genesis/closure.h"
		#include "genesis/fdefn.h"
		#include "genesis/simple-fun.h"
		#include "genesis/return-pc.h"
		#include "genesis/static-symbols.h"
		#include "genesis/funcallable-instance.h"

		.level 2.0
		.text

		.import $global$,data
		.import $$dyncall,MILLICODE
		.import foreign_function_call_active,data
		.import current_control_stack_pointer,data
		.import current_control_frame_pointer,data
		.import current_binding_stack_pointer,data
		.import dynamic_space_free_pointer,data
		/* .import return_from_lisp_function,data */

		/* .space $TEXT$
		.subspace $CODE$
		.import $$dyncall,MILLICODE
		*/

		/*
		* Call-into-lisp
		@@ -96,8 +103,8 @@ call_into_lisp:
		ldw 20(reg_CFP),reg_A5

		/* Calculate the LRA. */
		ldil L%lra+OTHER_POINTER_LOWTAG,reg_LRA
		ldo R%lra+OTHER_POINTER_LOWTAG(reg_LRA),reg_LRA
		ldil L%lra-RETURN_PC_RETURN_POINT_OFFSET,reg_LRA
		ldo R%lra-RETURN_PC_RETURN_POINT_OFFSET(reg_LRA),reg_LRA

		/* Indirect the closure */
		ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_CODE
		@@ -112,12 +119,14 @@ break_here:

		.align 8
		lra:
		.word RETURN_PC_HEADER_WIDETAG
		copy reg_OCFP,reg_CSP
		nop /* a few nops because we dont know where we land */
		nop /* the return convention would govern this */
		nop
		nop

		/* Copy CFP (%r4) into someplace else and restore r4. */
		copy reg_CFP,reg_NL1
		ldw -64(0,%sp),%r4
		ldw -0x3c(0,%sp),%r4

		/* Copy the return value. */
		copy reg_A0,%ret0
		@@ -144,7 +153,6 @@ lra:
		/* Turn off pseudo-atomic and check for traps. */
		addit,od -4,reg_ALLOC,reg_ALLOC


		ldw -0x54(%sr0,%sp),%rp
		ldw -0x4(%sr0,%sp),%r18
		ldw -0x8(%sr0,%sp),%r17
		@@ -164,7 +172,6 @@ lra:
		bv %r0(%rp)
		ldwm -0x40(%sr0,%sp),%r3


		/* And thats all. */
		.exit
		.procend
		@@ -174,22 +181,22 @@ lra:
		* Call-into-C
		*/


		.export call_into_c
		call_into_c:
		/* Set up a lisp stack frame. Note: we convert the raw return pc into
		* a fixnum pc-offset because we don't have ahold of an lra object.
		*/
		/* Set up a lisp stack frame. */
		copy reg_CFP, reg_OCFP
		copy reg_CSP, reg_CFP
		addi 32, reg_CSP, reg_CSP
		stw reg_OCFP, 0(0,reg_CFP)
		stw reg_OCFP, 0(0,reg_CFP) ; save old cfp
		stw reg_CFP, 4(0,reg_CFP) ; save old csp
		/* convert raw return PC into a fixnum PC-offset, because we dont
		have ahold of an lra object */
		sub reg_LIP, reg_CODE, reg_NL5
		addi 3-OTHER_POINTER_LOWTAG, reg_NL5, reg_NL5
		stw reg_NL5, 4(0,reg_CFP)
		stw reg_CODE, 8(0,reg_CFP)
		stw reg_NL5, 8(0,reg_CFP)
		stw reg_CODE, 0xc(0,reg_CFP)

		/* Turn on pseudo-atomic. */
		/* set pseudo-atomic flag */
		addi 4, reg_ALLOC, reg_ALLOC

		/* Store the lisp state. */
		@@ -216,7 +223,7 @@ call_into_c:
		copy reg_CFUNC, %r22
		bl $$dyncall,%r31
		copy %r31, %r2

		call_into_c_return:
		/* Clear the callee saves descriptor regs. */
		copy %r0, reg_A5
		copy %r0, reg_L0
		@@ -245,24 +252,35 @@ call_into_c:
		/* Restore CODE. Even though it is in a callee saves register
		* it might have been GC'ed.
		*/
		ldw 8(0,reg_CFP), reg_CODE
		ldw 0xc(0,reg_CFP), reg_CODE

		/* Restore the return pc. */
		ldw 4(0,reg_CFP), reg_NL0
		ldw 8(0,reg_CFP), reg_NL0
		addi OTHER_POINTER_LOWTAG-3, reg_NL0, reg_NL0
		/*
		addi -3, reg_NL0, reg_NL0
		ldi OTHER_POINTER_LOWTAG, reg_NL1
		sub reg_NL0, reg_NL1, reg_NL0
		*/
		add reg_CODE, reg_NL0, reg_LIP

		/* Pop the lisp stack frame, and back we go. */
		copy reg_CFP, reg_CSP
		be 0(4,reg_LIP)
		ldw 4(0,reg_CFP), reg_CSP
		ldw 0(0,reg_CFP), reg_OCFP
		copy reg_OCFP, reg_CFP

		be 0(5,reg_LIP)
		nop


		/*
		* Stuff to sanctify a block of memory for execution.
		* FIX why does this code work: parisc2.0 guide tells
		* us that we should add an sync after fdc and fic and
		* then let seven nops be executed before executing the
		* sanctified code.
		*/


		.EXPORT sanctify_for_execution
		sanctify_for_execution:
		.proc
		@@ -287,29 +305,6 @@ sanctify_loop:
		.exit
		.procend


		/*
		* Trampolines.
		*/

		.EXPORT closure_tramp
		closure_tramp:
		/* reg_FDEFN holds the fdefn object. */
		ldw FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV
		ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0
		addi SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP
		bv,n 0(reg_LIP)

		.EXPORT undefined_tramp
		undefined_tramp:
		break trap_Error,0
		.byte 4
		.byte UNDEFINED_FUN_ERROR
		.byte 254
		.byte (0x20 + sc_DescriptorReg)
		.byte 1
		.align 4


		/*
		* Core saving/restoring support
		@@ -426,10 +421,13 @@ restore_state:



		.export SingleStepTraps
		SingleStepTraps:
		/* FIX, add support for singlestep
		break trap_SingleStepBreakpoint,0
		break trap_SingleStepBreakpoint,0
		*/
		.export SingleStepTraps
		SingleStepTraps:

		/* Missing !! NOT
		there's a break 0,0 in the new version here!!!
		*/
		@@ -457,3 +455,30 @@ fun_end_breakpoint_trap:

		.export fun_end_breakpoint_end
		fun_end_breakpoint_end:

		/* FIX-lav: these are found in assem-rtns.lisp too, but
		genesis.lisp has problem referencing them, so we keep
		these old versions too. Lisp code cant jump to them
		because it is an inter space jump but lisp do intra
		space jumps */

		.align 8
		.EXPORT closure_tramp
		closure_tramp:
		/* reg_FDEFN holds the fdefn object. */
		ldw FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV
		ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0
		addi SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP
		bv,n 0(reg_LIP)

		.align 8
		.EXPORT undefined_tramp
		undefined_tramp:
		break trap_Error,0
		.byte 4
		.byte UNDEFINED_FUN_ERROR
		.byte 254
		.byte (0x20 + sc_DescriptorReg)
		.byte 1
		.align 4

src/runtime/hppa-hpux-os.c

0 → 100644

+91 −0

Original line number	Diff line number	Diff line
		/*
		* This is the HPPA HPUX incarnation of arch-dependent OS-dependent
		* routines. See also "hppa-os.c".
		*/

		/*
		* This software is part of the SBCL system. See the README file for
		* more information.
		*
		* This software is derived from the CMU CL system, which was
		* written at Carnegie Mellon University and released into the
		* public domain. The software is in the public domain and is
		* provided with absolutely no warranty. See the COPYING and CREDITS
		* files for more information.
		*/

		#include <stdio.h>
		#include <sys/param.h>
		#include <sys/file.h>
		#include "sbcl.h"
		#include "./signal.h"
		#include "os.h"
		#include "arch.h"
		#include "globals.h"
		#include "interrupt.h"
		#include "interr.h"
		#include "lispregs.h"
		#include <sys/socket.h>
		#include <sys/utsname.h>

		#include <sys/types.h>
		#include <signal.h>
		#include <sys/time.h>
		#include <sys/stat.h>
		#include <unistd.h>

		#include "validate.h"
		size_t os_vm_page_size;

		#ifdef LISP_FEATURE_SB_THREAD
		#error "Define threading support functions"
		#else
		int arch_os_thread_init(struct thread *thread) {
		return 1; /* success */
		}
		int arch_os_thread_cleanup(struct thread *thread) {
		return 1; /* success */
		}
		#endif

		/* for hpux read /usr/include/machine/save_state.h
		* os_context_register_addr() may not be used
		* to modify registers without setting a state-flag too */
		os_context_register_t *
		os_context_register_addr(os_context_t *context, int offset)
		{
		return (os_context_register_t *)
		((unsigned int)(&((ucontext_t ) context)->uc_mcontext.ss_wide.ss_64)) + (offset 2) + 1;
		}

		os_context_register_t *
		os_context_pc_addr(os_context_t *context)
		{
		/* Why do I get all the silly ports? -- CSR, 2002-08-11 */
		return ((unsigned int) &((ucontext_t *) context)->uc_mcontext.ss_wide.ss_64.ss_pcoq_head + 4);
		}

		os_context_register_t *
		os_context_npc_addr(os_context_t *context)
		{
		return ((unsigned int) &((ucontext_t *) context)->uc_mcontext.ss_wide.ss_64.ss_pcoq_tail + 4);
		}

		sigset_t *
		os_context_sigmask_addr(os_context_t *context)
		{
		return &(((ucontext_t *)context)->uc_subcontext.__uc_sigmask);
		}

		void
		os_restore_fp_control(os_context_t *context)
		{
		/* FIXME: Probably do something. */
		}

		void
		os_flush_icache(os_vm_address_t address, os_vm_size_t length)
		{
		/* FIXME: Maybe this is OK. */
		sanctify_for_execution(address,length);
		}

src/runtime/hppa-hpux-os.h

0 → 100644

+17 −0

Original line number	Diff line number	Diff line
		#ifndef _HPPA_HPUX_OS_H
		#define _HPPA_HPUX_OS_H

		typedef struct ucontext_t os_context_t;
		typedef unsigned long os_context_register_t;

		static inline os_context_t arch_os_get_context(void *void_context)
		{
		return (os_context_t ) void_context;
		}

		unsigned long os_context_fp_control(os_context_t *context);
		void os_restore_fp_control(os_context_t *context);

		#define REGISTER_ACCESS(context,offset) ((os_context_register_t ) ((unsigned int)(&((ucontext_t ) context)->uc_mcontext.ss_wide.ss_64)) + (offset * 2) + 1)

		#endif /* _HPPA_HPUX_OS_H */