changecom(`;');;; -*-Midas-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpauxmd/hppa.m4,v 1.16 1991/07/11 03:58:59 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpauxmd/hppa.m4,v 1.17 1991/08/13 06:46:08 jinx Exp $
;;;
;;; Copyright (c) 1989-91 Massachusetts Institute of Technology
;;;
LDO R'Registers-$global$(1),4 ; Setup Regs
LDI QUAD_MASK,5
-interface_to_scheme
+ep_interface_to_scheme
LDW 8(0,4),2 ; Move interpreter reg to val
LDW 0(0,4),20 ; Setup memtop
ADDIL L'Ext_Stack_Pointer-$global$,27
DEP 0,31,2,26
scheme_to_interface
STW 2,8(0,4) ; Move val to interpreter reg
- ADDIL L'utility_table-$global$,27
- LDO R'utility_table-$global$(1),29
+ ADDIL L'hppa_utility_table-$global$,27
+ LDO R'hppa_utility_table-$global$(1),29
LDWX,S 28(0,29),29 ; Find handler
ADDIL L'Ext_Stack_Pointer-$global$,27
STW 22,R'Ext_Stack_Pointer-$global$(1) ; Update stack pointer
;;; to return to the interpreter.
;;; It returns from C_to_interface.
-interface_to_C
+ep_interface_to_C
COPY 29,28 ; Setup C value
LDW -132(0,30),2 ; Restore return address
LDW -52(0,30),18 ; Restore saved registers
.PROC
.CALLINFO CALLER,FRAME=0
.ENTRY
- LDO 4(30),30
+ LDO 4(30),30 ; Allocate stack slot
FSTWS 0,0(30)
LDW 0(30),22
LDI 30,21 ; enable V, Z, O, U traps
OR 21,22,22
STW 22,0(30)
FLDWS 0(30),0
+ ; Prepare entry points
+ BL known_pc,28 ; get pc
+ ADDIL L'ep_interface_to_scheme-known_pc,28
+known_pc
+ LDO R'ep_interface_to_scheme-known_pc(1),29
+ ADDIL L'interface_to_scheme-$global$,27
+ STW 29,R'interface_to_scheme-$global$(0,1)
+ ADDIL L'ep_interface_to_C-known_pc,28
+ LDO R'ep_interface_to_C-known_pc(1),29
+ ADDIL L'interface_to_C-$global$,27
+ STW 29,R'interface_to_C-$global$(0,1)
+ ; Return
BV 0(2)
.EXIT
- LDO -4(30),30
+ LDO -4(30),30 ; De-allocate stack slot
.PROCEND
\f
;;;; Routine to flush some locations from the processor cache.
.SUBSPA $UNWIND$,QUAD=0,ALIGN=8,ACCESS=44
.SUBSPA $CODE$
.SPACE $PRIVATE$
+ .SUBSPA $SHORTBSS$
+interface_to_scheme .COMM 4
+interface_to_C .COMM 4
.SUBSPA $DATA$,QUAD=1,ALIGN=8,ACCESS=31
$THISMODULE$
ifelse(ASM_DEBUG,1,"interface_counter
.IMPORT Registers,DATA
.IMPORT Ext_Stack_Pointer,DATA
.IMPORT Free,DATA
- .IMPORT utility_table,DATA
+ .IMPORT hppa_utility_table,DATA
.SPACE $TEXT$
.SUBSPA $CODE$
.EXPORT C_to_interface,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
.EXPORT interface_initialize,PRIV_LEV=3
- .EXPORT interface_to_scheme,PRIV_LEV=3
- .EXPORT interface_to_C,PRIV_LEV=3
.EXPORT scheme_to_interface_ble,PRIV_LEV=3
.EXPORT trampoline_to_interface,PRIV_LEV=3
.EXPORT scheme_to_interface,PRIV_LEV=3
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpint.c,v 1.37 1991/07/12 23:15:43 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpint.c,v 1.38 1991/08/13 06:45:36 jinx Exp $
Copyright (c) 1989-1991 Massachusetts Institute of Technology
typedef char instruction;
+#ifdef C_FUNC_PTR_IS_CLOSURE
+# define REFENTRY(name) (name)
+# define VARENTRY(name) instruction *name
+# define EXTENTRY(name) extern instruction *name
+#else
+# define REFENTRY(name) ((void (*)()) name)
+# define VARENTRY(name) void (*name)()
+# define EXTENTRY(name) extern void EXFUN (name, (void))
+#endif
+
/* Structure returned by SCHEME_UTILITYs */
struct utility_result
{
- void (*interface_dispatch)();
+ VARENTRY (interface_dispatch);
union additional_info
{
long code_to_interpreter;
do { \
struct utility_result temp; \
\
- temp.interface_dispatch = ((void (*)()) interface_to_C); \
+ temp.interface_dispatch = (REFENTRY (interface_to_C)); \
temp.extra.code_to_interpreter = (code); \
\
return (temp); \
do { \
struct utility_result temp; \
\
- temp.interface_dispatch = ((void (*)()) interface_to_scheme); \
+ temp.interface_dispatch = (REFENTRY (interface_to_scheme)); \
temp.extra.entry_point = ((instruction *) (ep)); \
\
return (temp); \
extern long
EXFUN (C_to_interface, (void *));
-extern void
- EXFUN (interface_to_C, (void)),
- EXFUN (interface_to_scheme, (void));
+EXTENTRY (interface_to_C);
+EXTENTRY (interface_to_scheme);
/* Exports to the rest of the "microcode" */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/hppa.h,v 1.22 1991/07/11 03:59:15 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/hppa.h,v 1.23 1991/08/13 06:45:50 jinx Exp $
Copyright (c) 1989-1991 Massachusetts Institute of Technology
*/
#define PC_ZERO_BITS 2
+
+/* C function pointers are pairs of instruction addreses and data segment
+ pointers. We don't want that for the assembly language entry points.
+ */
+
+#define C_FUNC_PTR_IS_CLOSURE
\f
/* Utilities for manipulating absolute subroutine calls.
On the PA the absolute address is "smeared out" over two
unsigned pad : 2;
} fields;
};
+
+union bl_offset
+{
+ long value;
+ struct
+ {
+ int sign_pad : 13;
+ unsigned w0 : 1;
+ unsigned w1 : 5;
+ unsigned w2a : 1;
+ unsigned w2b : 10;
+ unsigned pad : 2;
+ } fields;
+};
\f
/*
Note: The following does not do a full decoding of the BLE instruction.
#ifdef IN_CMPINT_C
-/* This loads the cache information structure for use by flush_i_cache.
+#define ASM_RESET_HOOK() \
+do { \
+ hppa_reset_hook (((sizeof (utility_table)) / (sizeof (void *))), \
+ &utility_table[0]); \
+} while (0)
+
+long
+DEFUN (assemble_17,
+ (inst),
+ union ble_inst inst)
+{
+ union bl_offset off;
+
+ off.fields.pad = 0;
+ off.fields.w2b = inst.fields.w2b;
+ off.fields.w2a = inst.fields.w2a;
+ off.fields.w1 = inst.fields.w1;
+ off.fields.w0 = inst.fields.w0;
+ off.fields.sign_pad = ((inst.fields.w0 == 0) ? 0 : -1);
+ return off.value;
+}
+
+#include <magic.h>
+
+/* This loads the cache information structure for use by flush_i_cache,
+ sets the floating point flags correctly, and accommodates the c
+ function pointer closure format problems for utilities for HP-UX >= 8.0 .
*/
-#define ASM_RESET_HOOK hppa_reset_hook
+#define HPPA_TABLE_LENGTH 100
+
+extern void *hppa_utility_table[];
+void *hppa_utility_table[HPPA_TABLE_LENGTH];
void
-DEFUN_VOID (hppa_reset_hook)
+DEFUN (hppa_reset_hook,
+ (table_length, utility_table),
+ long table_length AND
+ void **utility_table)
{
+ long counter;
extern void interface_initialize ();
+ void **hppa_table;
+
flush_i_cache_initialize ();
interface_initialize ();
+
+ if (table_length > HPPA_TABLE_LENGTH)
+ {
+ fprintf (stderr,
+ "hppa_reset_hook: HPPA_TABLE_LENGTH (%d) < %d\n",
+ HPPA_TABLE_LENGTH, table_length);
+ exit (1);
+ }
+
+ hppa_table = &hppa_utility_table[0];
+ for (counter = 0; counter < table_length; counter++)
+ {
+ /* Test for HP-UX >= 8.0 */
+
+#if defined(SHL_MAGIC) && !defined(__GNUC__)
+ char *C_closure, *blp;
+ long offset;
+
+ C_closure = ((char *) utility_table[counter]);
+ blp = (* ((char **) (C_closure - 2)));
+ blp = ((char *) (((unsigned long) blp) & ~3));
+ offset = (assemble_17 (* ((union ble_inst *) blp)));
+ hppa_table[counter] = ((void *) ((blp + 8) + offset));
+
+#else
+ hppa_table[counter] = ((void *) utility_table[counter]);
+#endif
+ }
}
#endif /* IN_CMPINT_C */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.93 1991/08/06 22:15:35 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.94 1991/08/13 06:45:17 jinx Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 93
+#define SUBVERSION 94
#endif
changecom(`;');;; -*-Midas-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpauxmd/hppa.m4,v 1.16 1991/07/11 03:58:59 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpauxmd/hppa.m4,v 1.17 1991/08/13 06:46:08 jinx Exp $
;;;
;;; Copyright (c) 1989-91 Massachusetts Institute of Technology
;;;
LDO R'Registers-$global$(1),4 ; Setup Regs
LDI QUAD_MASK,5
-interface_to_scheme
+ep_interface_to_scheme
LDW 8(0,4),2 ; Move interpreter reg to val
LDW 0(0,4),20 ; Setup memtop
ADDIL L'Ext_Stack_Pointer-$global$,27
DEP 0,31,2,26
scheme_to_interface
STW 2,8(0,4) ; Move val to interpreter reg
- ADDIL L'utility_table-$global$,27
- LDO R'utility_table-$global$(1),29
+ ADDIL L'hppa_utility_table-$global$,27
+ LDO R'hppa_utility_table-$global$(1),29
LDWX,S 28(0,29),29 ; Find handler
ADDIL L'Ext_Stack_Pointer-$global$,27
STW 22,R'Ext_Stack_Pointer-$global$(1) ; Update stack pointer
;;; to return to the interpreter.
;;; It returns from C_to_interface.
-interface_to_C
+ep_interface_to_C
COPY 29,28 ; Setup C value
LDW -132(0,30),2 ; Restore return address
LDW -52(0,30),18 ; Restore saved registers
.PROC
.CALLINFO CALLER,FRAME=0
.ENTRY
- LDO 4(30),30
+ LDO 4(30),30 ; Allocate stack slot
FSTWS 0,0(30)
LDW 0(30),22
LDI 30,21 ; enable V, Z, O, U traps
OR 21,22,22
STW 22,0(30)
FLDWS 0(30),0
+ ; Prepare entry points
+ BL known_pc,28 ; get pc
+ ADDIL L'ep_interface_to_scheme-known_pc,28
+known_pc
+ LDO R'ep_interface_to_scheme-known_pc(1),29
+ ADDIL L'interface_to_scheme-$global$,27
+ STW 29,R'interface_to_scheme-$global$(0,1)
+ ADDIL L'ep_interface_to_C-known_pc,28
+ LDO R'ep_interface_to_C-known_pc(1),29
+ ADDIL L'interface_to_C-$global$,27
+ STW 29,R'interface_to_C-$global$(0,1)
+ ; Return
BV 0(2)
.EXIT
- LDO -4(30),30
+ LDO -4(30),30 ; De-allocate stack slot
.PROCEND
\f
;;;; Routine to flush some locations from the processor cache.
.SUBSPA $UNWIND$,QUAD=0,ALIGN=8,ACCESS=44
.SUBSPA $CODE$
.SPACE $PRIVATE$
+ .SUBSPA $SHORTBSS$
+interface_to_scheme .COMM 4
+interface_to_C .COMM 4
.SUBSPA $DATA$,QUAD=1,ALIGN=8,ACCESS=31
$THISMODULE$
ifelse(ASM_DEBUG,1,"interface_counter
.IMPORT Registers,DATA
.IMPORT Ext_Stack_Pointer,DATA
.IMPORT Free,DATA
- .IMPORT utility_table,DATA
+ .IMPORT hppa_utility_table,DATA
.SPACE $TEXT$
.SUBSPA $CODE$
.EXPORT C_to_interface,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
.EXPORT interface_initialize,PRIV_LEV=3
- .EXPORT interface_to_scheme,PRIV_LEV=3
- .EXPORT interface_to_C,PRIV_LEV=3
.EXPORT scheme_to_interface_ble,PRIV_LEV=3
.EXPORT trampoline_to_interface,PRIV_LEV=3
.EXPORT scheme_to_interface,PRIV_LEV=3
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpint.c,v 1.37 1991/07/12 23:15:43 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpint.c,v 1.38 1991/08/13 06:45:36 jinx Exp $
Copyright (c) 1989-1991 Massachusetts Institute of Technology
typedef char instruction;
+#ifdef C_FUNC_PTR_IS_CLOSURE
+# define REFENTRY(name) (name)
+# define VARENTRY(name) instruction *name
+# define EXTENTRY(name) extern instruction *name
+#else
+# define REFENTRY(name) ((void (*)()) name)
+# define VARENTRY(name) void (*name)()
+# define EXTENTRY(name) extern void EXFUN (name, (void))
+#endif
+
/* Structure returned by SCHEME_UTILITYs */
struct utility_result
{
- void (*interface_dispatch)();
+ VARENTRY (interface_dispatch);
union additional_info
{
long code_to_interpreter;
do { \
struct utility_result temp; \
\
- temp.interface_dispatch = ((void (*)()) interface_to_C); \
+ temp.interface_dispatch = (REFENTRY (interface_to_C)); \
temp.extra.code_to_interpreter = (code); \
\
return (temp); \
do { \
struct utility_result temp; \
\
- temp.interface_dispatch = ((void (*)()) interface_to_scheme); \
+ temp.interface_dispatch = (REFENTRY (interface_to_scheme)); \
temp.extra.entry_point = ((instruction *) (ep)); \
\
return (temp); \
extern long
EXFUN (C_to_interface, (void *));
-extern void
- EXFUN (interface_to_C, (void)),
- EXFUN (interface_to_scheme, (void));
+EXTENTRY (interface_to_C);
+EXTENTRY (interface_to_scheme);
/* Exports to the rest of the "microcode" */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpintmd/hppa.h,v 1.22 1991/07/11 03:59:15 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpintmd/hppa.h,v 1.23 1991/08/13 06:45:50 jinx Exp $
Copyright (c) 1989-1991 Massachusetts Institute of Technology
*/
#define PC_ZERO_BITS 2
+
+/* C function pointers are pairs of instruction addreses and data segment
+ pointers. We don't want that for the assembly language entry points.
+ */
+
+#define C_FUNC_PTR_IS_CLOSURE
\f
/* Utilities for manipulating absolute subroutine calls.
On the PA the absolute address is "smeared out" over two
unsigned pad : 2;
} fields;
};
+
+union bl_offset
+{
+ long value;
+ struct
+ {
+ int sign_pad : 13;
+ unsigned w0 : 1;
+ unsigned w1 : 5;
+ unsigned w2a : 1;
+ unsigned w2b : 10;
+ unsigned pad : 2;
+ } fields;
+};
\f
/*
Note: The following does not do a full decoding of the BLE instruction.
#ifdef IN_CMPINT_C
-/* This loads the cache information structure for use by flush_i_cache.
+#define ASM_RESET_HOOK() \
+do { \
+ hppa_reset_hook (((sizeof (utility_table)) / (sizeof (void *))), \
+ &utility_table[0]); \
+} while (0)
+
+long
+DEFUN (assemble_17,
+ (inst),
+ union ble_inst inst)
+{
+ union bl_offset off;
+
+ off.fields.pad = 0;
+ off.fields.w2b = inst.fields.w2b;
+ off.fields.w2a = inst.fields.w2a;
+ off.fields.w1 = inst.fields.w1;
+ off.fields.w0 = inst.fields.w0;
+ off.fields.sign_pad = ((inst.fields.w0 == 0) ? 0 : -1);
+ return off.value;
+}
+
+#include <magic.h>
+
+/* This loads the cache information structure for use by flush_i_cache,
+ sets the floating point flags correctly, and accommodates the c
+ function pointer closure format problems for utilities for HP-UX >= 8.0 .
*/
-#define ASM_RESET_HOOK hppa_reset_hook
+#define HPPA_TABLE_LENGTH 100
+
+extern void *hppa_utility_table[];
+void *hppa_utility_table[HPPA_TABLE_LENGTH];
void
-DEFUN_VOID (hppa_reset_hook)
+DEFUN (hppa_reset_hook,
+ (table_length, utility_table),
+ long table_length AND
+ void **utility_table)
{
+ long counter;
extern void interface_initialize ();
+ void **hppa_table;
+
flush_i_cache_initialize ();
interface_initialize ();
+
+ if (table_length > HPPA_TABLE_LENGTH)
+ {
+ fprintf (stderr,
+ "hppa_reset_hook: HPPA_TABLE_LENGTH (%d) < %d\n",
+ HPPA_TABLE_LENGTH, table_length);
+ exit (1);
+ }
+
+ hppa_table = &hppa_utility_table[0];
+ for (counter = 0; counter < table_length; counter++)
+ {
+ /* Test for HP-UX >= 8.0 */
+
+#if defined(SHL_MAGIC) && !defined(__GNUC__)
+ char *C_closure, *blp;
+ long offset;
+
+ C_closure = ((char *) utility_table[counter]);
+ blp = (* ((char **) (C_closure - 2)));
+ blp = ((char *) (((unsigned long) blp) & ~3));
+ offset = (assemble_17 (* ((union ble_inst *) blp)));
+ hppa_table[counter] = ((void *) ((blp + 8) + offset));
+
+#else
+ hppa_table[counter] = ((void *) utility_table[counter]);
+#endif
+ }
}
#endif /* IN_CMPINT_C */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.93 1991/08/06 22:15:35 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.94 1991/08/13 06:45:17 jinx Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 93
+#define SUBVERSION 94
#endif
projects / mit-scheme.git / commitdiff