3
$Id: hppa.h,v 1.51 1999/01/02 06:06:43 cph Exp $
5
Copyright (c) 1989-1999 Massachusetts Institute of Technology
7
This program is free software; you can redistribute it and/or modify
8
it under the terms of the GNU General Public License as published by
9
the Free Software Foundation; either version 2 of the License, or (at
10
your option) any later version.
12
This program is distributed in the hope that it will be useful, but
13
WITHOUT ANY WARRANTY; without even the implied warranty of
14
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15
General Public License for more details.
17
You should have received a copy of the GNU General Public License
18
along with this program; if not, write to the Free Software
19
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
24
* Compiled code interface macros.
26
* See cmpint.txt for a description of these fields.
28
* Specialized for the HP Precision Architecture (Spectrum)
31
#ifndef CMPINTMD_H_INCLUDED
32
#define CMPINTMD_H_INCLUDED
37
/* Machine parameters to be set by the user. */
39
/* Until cmpaux-hppa.m4 is updated. */
40
#define CMPINT_USE_STRUCS
42
/* Processor type. Choose a number from the above list, or allocate your own. */
44
#define COMPILER_PROCESSOR_TYPE COMPILER_SPECTRUM_TYPE
46
/* Size (in long words) of the contents of a floating point register if
47
different from a double. For example, an MC68881 saves registers
48
in 96 bit (3 longword) blocks.
49
Default is fine for PA.
50
define COMPILER_TEMP_SIZE 3
54
This is the size of the offset field, and of the format field.
55
This definition probably does not need to be changed.
58
typedef unsigned short format_word;
60
/* PC alignment constraint.
61
Change PC_ZERO_BITS to be how many low order bits of the pc are
62
guaranteed to be 0 always because of PC alignment constraints.
65
#define PC_ZERO_BITS 2
67
/* C function pointers are pairs of instruction addreses and data segment
68
pointers. We don't want that for the assembly language entry points.
71
#define C_FUNC_PTR_IS_CLOSURE
73
#ifndef C_FUNC_PTR_IS_CLOSURE
74
# define interface_to_C ep_interface_to_C
75
# define interface_to_scheme ep_interface_to_scheme
78
/* Utilities for manipulating absolute subroutine calls.
79
On the PA the absolute address is "smeared out" over two
80
instructions, an LDIL and a BLE instruction.
84
EXFUN (hppa_extract_absolute_address, (unsigned long *));
87
EXFUN (hppa_store_absolute_address,
88
(unsigned long *, unsigned long, unsigned long));
90
#define EXTRACT_ABSOLUTE_ADDRESS(target, address) \
94
(hppa_extract_absolute_address ((unsigned long *) (address)))); \
97
#define STORE_ABSOLUTE_ADDRESS(entry_point, address, nullify_p) \
99
hppa_store_absolute_address (((unsigned long *) (address)), \
100
((unsigned long) (entry_point)), \
101
((unsigned long) (nullify_p))); \
104
/* Interrupt/GC polling. */
106
/* The length of the GC recovery code that precedes an entry.
107
On the HP-PA a "ble, ldi" instruction sequence.
110
#define ENTRY_PREFIX_LENGTH 8
113
The instructions for a normal entry should be something like
115
COMBT,>=,N Rfree,Rmemtop,interrupt
116
LDW 0(0,Regs),Rmemtop
120
DEPI tc_closure>>1,4,5,25 ; set type code
121
STWM 25,-4(0,Rstack) ; push on stack
122
COMB,>= Rfree,Rmemtop,interrupt ; GC/interrupt check
123
LDW 0(0,Regs),Rmemtop ; Recache memtop
127
The LDW can be eliminated once the C interrupt handler is changed to
128
update Rmemtop directly. At that point, the instruction following the
129
COMB instruction will have to be nullified whenever the interrupt
134
/* Compiled closures */
136
/* Manifest closure entry block size.
137
Size in bytes of a compiled closure's header excluding the
138
TC_MANIFEST_CLOSURE header.
140
On the PA this is 2 format_words for the format word and gc
141
offset words, and 12 more bytes for 3 instructions:
145
ADDI -15,31,25 ; handle privilege bits
148
#define COMPILED_CLOSURE_ENTRY_SIZE 16
150
/* Manifest closure entry destructuring.
152
Given the entry point of a closure, extract the `real entry point'
153
(the address of the real code of the procedure, ie. one indirection)
155
On the PA, the real entry point is "smeared out" over the LDIL and
156
the BLE instructions.
159
#define EXTRACT_CLOSURE_ENTRY_ADDRESS(real_entry_point, entry_point) \
161
EXTRACT_ABSOLUTE_ADDRESS (real_entry_point, entry_point); \
164
/* This is the inverse of EXTRACT_CLOSURE_ENTRY_ADDRESS.
165
Given a closure's entry point and a code entry point, store the
166
code entry point in the closure.
169
#define STORE_CLOSURE_ENTRY_ADDRESS(real_entry_point, entry_point) \
171
STORE_ABSOLUTE_ADDRESS (real_entry_point, entry_point, false); \
176
Here's a picture of a trampoline on the PA (offset in bytes from
179
-12: MANIFEST vector header
180
- 8: NON_MARKED header
182
- 2: 0xC (GC Offset to start of block from .+2)
183
0: BLE 4(4,3) ; call trampoline_to_interface
185
8: trampoline dependent storage (0 - 3 longwords)
187
TRAMPOLINE_ENTRY_SIZE is the size in longwords of the machine
188
dependent portion of a trampoline, including the GC and format
189
headers. The code in the trampoline must store an index (used to
190
determine which C SCHEME_UTILITY procedure to invoke) in a
191
register, jump to "scheme_to_interface" and leave the address of
192
the storage following the code in a standard location.
194
TRAMPOLINE_ENTRY_POINT returns the address of the entry point of a
195
trampoline when given the address of the word containing
196
the manifest vector header. According to the above picture,
197
it would add 12 bytes to its argument.
199
TRAMPOLINE_STORAGE takes the address of the first instruction in a
200
trampoline (not the start of the trampoline block) and returns the
201
address of the first storage word in the trampoline.
203
STORE_TRAMPOLINE_ENTRY gets the address of the first instruction in
204
the trampoline and stores the instructions. It also receives the
205
index of the C SCHEME_UTILITY to be invoked.
207
Note: this flushes both caches because the words may fall in a cache
208
line that already has an association in the i-cache because a different
209
trampoline or a closure are in it.
212
#define TRAMPOLINE_ENTRY_SIZE 3
213
#define TRAMPOLINE_BLOCK_TO_ENTRY 3 /* longwords from MNV to BLE */
215
#define TRAMPOLINE_ENTRY_POINT(tramp_block) \
216
(((SCHEME_OBJECT *) (tramp_block)) + TRAMPOLINE_BLOCK_TO_ENTRY)
218
#define TRAMPOLINE_STORAGE(tramp_entry) \
219
((((SCHEME_OBJECT *) (tramp_entry)) - TRAMPOLINE_BLOCK_TO_ENTRY) + \
220
(2 + TRAMPOLINE_ENTRY_SIZE))
222
#define STORE_TRAMPOLINE_ENTRY(entry_address, index) do \
225
EXFUN (cache_flush_region, (PTR, long, unsigned int)); \
229
PC = ((unsigned long *) (entry_address)); \
233
*PC = ((unsigned long) 0xe4602008); \
235
/* LDO index(0),28 */ \
236
/* This assumes that index is >= 0. */ \
238
*(PC + 1) = (((unsigned long) 0x341c0000) + \
239
(((unsigned long) (index)) << 1)); \
240
cache_flush_region (PC, (TRAMPOLINE_ENTRY_SIZE - 1), \
241
(I_CACHE | D_CACHE)); \
244
/* Execute cache entries.
246
Execute cache entry size size in longwords. The cache itself
247
contains both the number of arguments provided by the caller and
248
code to jump to the destination address. Before linkage, the cache
249
contains the callee's name instead of the jump code.
251
On PA: 2 instructions, and a fixnum representing the number of arguments.
254
#define EXECUTE_CACHE_ENTRY_SIZE 3
256
/* For the HPPA, addresses in bytes from the start of the cache:
260
+0: TC_SYMBOL || symbol address
263
+10: number of supplied arguments, +1
268
+4: BLE,n R'target(5,26)
274
Currently the code below unconditionally nullifies the delay-slot
275
instruction for the BLE instruction. This is wasteful and
276
unnecessary. An EXECUTE_CACHE_ENTRY could be one word longer to
277
accomodate a delay-slot instruction, and the linker could do the
280
- If the target instruction is not a branch instruction, use 4 +
281
the address of the target instruction, and copy the target
282
instruction to the delay slot. Note that branch instructions are
283
those with opcodes (6 bits) in the range #b1xy0zw, for any bit
284
value for x, y, z, w.
286
- If the target instruction is the COMBT instruction of an
287
interrupt/gc check, use 4 + the address of the target
288
instruction, and insert a similar COMBT instruction in the delay
289
slot. This COMBT instruction would then branch to an instruction
290
shared by all the cache cells in the same block. This shared
291
instruction would be a BE instruction used to jump to an assembly
292
language handler. This handler would recover the target address
293
from the link address left in register 31 by the BLE instruction
294
in the execute cache cell, and use it to compute the address of
295
and branch to the interrupt code for the entry.
297
- Otherwise use the address of the target instruction and insert
298
a NOP in the delay slot.
301
/* Execute cache destructuring. */
303
/* Given a target location and the address of the first word of an
304
execute cache entry, extract from the cache cell the number of
305
arguments supplied by the caller and store it in target.
308
#define EXTRACT_EXECUTE_CACHE_ARITY(target, address) \
310
(target) = ((long) (* (((unsigned short *) (address)) + 5))); \
313
/* Given a target location and the address of the first word of an
314
execute cache entry, extract from the cache cell the name
315
of the variable whose value is being invoked.
316
This is valid only before linking.
319
#define EXTRACT_EXECUTE_CACHE_SYMBOL(target, address) \
321
(target) = (* (((SCHEME_OBJECT *) (address)))); \
324
/* Extract the target address (not the code to get there) from an
328
#define EXTRACT_EXECUTE_CACHE_ADDRESS(target, address) \
330
EXTRACT_ABSOLUTE_ADDRESS(target, address); \
333
/* This is the inverse of EXTRACT_EXECUTE_CACHE_ADDRESS. */
335
#define STORE_EXECUTE_CACHE_ADDRESS(address, entry) \
337
STORE_ABSOLUTE_ADDRESS(entry, address, true); \
340
/* This stores the fixed part of the instructions leaving the
341
destination address and the number of arguments intact. These are
342
split apart so the GC can call EXTRACT/STORE...ADDRESS but it does
343
NOT need to store the instructions back. On some architectures the
344
instructions may change due to GC and then STORE_EXECUTE_CACHE_CODE
345
should become a no-op and all of the work is done by
346
STORE_EXECUTE_CACHE_ADDRESS instead.
350
#define STORE_EXECUTE_CACHE_CODE(address) do \
354
/* This is supposed to flush the Scheme portion of the I-cache.
355
It flushes the entire I-cache instead, since it is easier.
356
It is used after a GC or disk-restore.
357
It's needed because the GC has moved code around, and closures
358
and execute cache cells have absolute addresses that the
359
processor might have old copies of.
362
#define FLUSH_I_CACHE() do \
365
EXFUN (flush_i_cache, (void)); \
370
/* This flushes a region of the I-cache.
371
It is used after updating an execute cache while running.
372
Not needed during GC because FLUSH_I_CACHE will be used.
375
#define FLUSH_I_CACHE_REGION(address, nwords) do \
378
EXFUN (cache_flush_region, (PTR, long, unsigned int)); \
380
cache_flush_region (((PTR) (address)), ((long) (nwords)), \
381
(D_CACHE | I_CACHE)); \
384
/* This pushes a region of the D-cache back to memory.
385
It is (typically) used after loading (and relocating) a piece of code
389
#define PUSH_D_CACHE_REGION(address, nwords) do \
392
EXFUN (push_d_cache_region, (PTR, unsigned long)); \
394
push_d_cache_region (((PTR) (address)), \
395
((unsigned long) (nwords))); \
398
extern void EXFUN (hppa_update_primitive_table, (int, int));
399
extern Boolean EXFUN (hppa_grow_primitive_table, (int));
401
#define UPDATE_PRIMITIVE_TABLE_HOOK hppa_update_primitive_table
402
#define GROW_PRIMITIVE_TABLE_HOOK hppa_grow_primitive_table
404
/* This is not completely true. Some models (eg. 850) have combined caches,
405
but we have to assume the worst.
410
/* Derived parameters and macros.
412
These macros expect the above definitions to be meaningful.
413
If they are not, the macros below may have to be changed as well.
416
#define COMPILED_ENTRY_OFFSET_WORD(entry) \
417
(((format_word *) (entry))[-1])
418
#define COMPILED_ENTRY_FORMAT_WORD(entry) \
419
(((format_word *) (entry))[-2])
421
/* The next one assumes 2's complement integers....*/
422
#define CLEAR_LOW_BIT(word) ((word) & ((unsigned long) -2))
423
#define OFFSET_WORD_CONTINUATION_P(word) (((word) & 1) != 0)
425
#if (PC_ZERO_BITS == 0)
426
/* Instructions aligned on byte boundaries */
427
#define BYTE_OFFSET_TO_OFFSET_WORD(offset) ((offset) << 1)
428
#define OFFSET_WORD_TO_BYTE_OFFSET(offset_word) \
429
((CLEAR_LOW_BIT(offset_word)) >> 1)
432
#if (PC_ZERO_BITS == 1)
433
/* Instructions aligned on word (16 bit) boundaries */
434
#define BYTE_OFFSET_TO_OFFSET_WORD(offset) (offset)
435
#define OFFSET_WORD_TO_BYTE_OFFSET(offset_word) \
436
(CLEAR_LOW_BIT(offset_word))
439
#if (PC_ZERO_BITS >= 2)
440
/* Should be OK for =2, but bets are off for >2 because of problems
443
#define SHIFT_AMOUNT (PC_ZERO_BITS - 1)
444
#define BYTE_OFFSET_TO_OFFSET_WORD(offset) ((offset) >> (SHIFT_AMOUNT))
445
#define OFFSET_WORD_TO_BYTE_OFFSET(offset_word) \
446
((CLEAR_LOW_BIT(offset_word)) << (SHIFT_AMOUNT))
449
#define MAKE_OFFSET_WORD(entry, block, continue) \
450
((BYTE_OFFSET_TO_OFFSET_WORD(((char *) (entry)) - \
451
((char *) (block)))) | \
452
((continue) ? 1 : 0))
454
#if (EXECUTE_CACHE_ENTRY_SIZE == 2)
455
#define EXECUTE_CACHE_COUNT_TO_ENTRIES(count) \
457
#define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries) \
461
#if (EXECUTE_CACHE_ENTRY_SIZE == 4)
462
#define EXECUTE_CACHE_COUNT_TO_ENTRIES(count) \
464
#define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries) \
468
#if (!defined(EXECUTE_CACHE_COUNT_TO_ENTRIES))
469
#define EXECUTE_CACHE_COUNT_TO_ENTRIES(count) \
470
((count) / EXECUTE_CACHE_ENTRY_SIZE)
471
#define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries) \
472
((entries) * EXECUTE_CACHE_ENTRY_SIZE)
475
/* The first entry in a cc block is preceeded by 2 headers (block and nmv),
476
a format word and a gc offset word. See the early part of the
477
TRAMPOLINE picture, above.
480
#define CC_BLOCK_FIRST_ENTRY_OFFSET \
481
(2 * ((sizeof(SCHEME_OBJECT)) + (sizeof(format_word))))
483
#ifndef FORMAT_BYTE_CLOSURE
484
#define FORMAT_BYTE_CLOSURE 0xFA
487
#ifndef FORMAT_WORD_CLOSURE
488
#define FORMAT_WORD_CLOSURE (MAKE_FORMAT_WORD (0xFF, FORMAT_BYTE_CLOSURE))
491
/* This assumes that a format word is at least 16 bits,
492
and the low order field is always 8 bits.
495
#define MAKE_FORMAT_WORD(field1, field2) \
496
(((field1) << 8) | ((field2) & 0xff))
498
#define SIGN_EXTEND_FIELD(field, size) \
499
(((field) & ((1 << (size)) - 1)) | \
500
((((field) & (1 << ((size) - 1))) == 0) ? 0 : \
503
#define FORMAT_WORD_LOW_BYTE(word) \
504
(SIGN_EXTEND_FIELD((((unsigned long) (word)) & 0xff), 8))
506
#define FORMAT_WORD_HIGH_BYTE(word) \
507
(SIGN_EXTEND_FIELD((((unsigned long) (word)) >> 8), \
508
(((sizeof (format_word)) * CHAR_BIT) - 8)))
510
#define COMPILED_ENTRY_FORMAT_HIGH(addr) \
511
(FORMAT_WORD_HIGH_BYTE(COMPILED_ENTRY_FORMAT_WORD(addr)))
513
#define COMPILED_ENTRY_FORMAT_LOW(addr) \
514
(FORMAT_WORD_LOW_BYTE(COMPILED_ENTRY_FORMAT_WORD(addr)))
516
#define COMPILED_ENTRY_MAXIMUM_ARITY COMPILED_ENTRY_FORMAT_LOW
517
#define COMPILED_ENTRY_MINIMUM_ARITY COMPILED_ENTRY_FORMAT_HIGH
521
/* Definitions of the utility procedures.
522
Procedure calls of leaf procedures on the HPPA are pretty fast,
523
so there is no reason not to do this out of line.
524
In this way compiled code can use them too.
549
unsigned x_or_w1 : 5;
560
unsigned long address;
601
DEFUN (assemble_17, (inst), union branch_inst inst)
603
union assemble_17_u off;
606
off.fields.w2b = inst.fields.w2b;
607
off.fields.w2a = inst.fields.w2a;
608
off.fields.w1 = inst.fields.x_or_w1;
609
off.fields.w0 = inst.fields.w0;
610
off.fields.sign_pad = ((inst.fields.w0 == 0) ? 0 : -1);
615
DEFUN (assemble_12, (inst), union branch_inst inst)
617
union assemble_12_u off;
620
off.fields.w2b = inst.fields.w2b;
621
off.fields.w2a = inst.fields.w2a;
622
off.fields.w0 = inst.fields.w0;
623
off.fields.sign_pad = ((inst.fields.w0 == 0) ? 0 : -1);
627
static unsigned long hppa_closure_hook = 0;
630
DEFUN (C_closure_entry_point, (C_closure), unsigned long C_closure)
632
if ((C_closure & 0x3) != 0x2)
638
unsigned long entry_point;
639
char * blp = (* ((char **) (C_closure - 2)));
641
blp = ((char *) (((unsigned long) blp) & ~3));
642
offset = (assemble_17 (* ((union branch_inst *) blp)));
643
entry_point = ((unsigned long) ((blp + 8) + offset));
644
return ((entry_point < ((unsigned long) &etext))
646
: hppa_closure_hook);
650
#define HAVE_BKPT_SUPPORT
652
static unsigned short branch_opcodes[] =
654
0x20, 0x21, 0x22, 0x23, 0x28, 0x29, 0x2a, 0x2b,
655
0x30, 0x31, 0x32, 0x33, 0x38, 0x39, 0x3a
659
branch_opcode_table[64];
663
closure_bkpt_instruction,
664
closure_entry_bkpt_instruction,
665
* bkpt_normal_proceed_thunk,
666
* bkpt_plus_proceed_thunk,
667
* bkpt_minus_proceed_thunk_start,
668
* bkpt_minus_proceed_thunk,
669
* bkpt_closure_proceed_thunk,
670
* bkpt_closure_proceed_thunk_end,
671
* bkpt_proceed_buffer = ((unsigned long *) NULL);
673
#define FAHRENHEIT 451
676
DEFUN_VOID (bkpt_init)
678
int i, this_size, max_size;
679
union branch_inst instr;
680
extern void EXFUN (bkpt_normal_proceed, (void));
681
extern void EXFUN (bkpt_plus_proceed, (void));
682
extern void EXFUN (bkpt_minus_proceed_start, (void));
683
extern void EXFUN (bkpt_minus_proceed, (void));
684
extern void EXFUN (bkpt_closure_proceed, (void));
685
extern void EXFUN (bkpt_closure_proceed_end, (void));
688
i < ((sizeof (branch_opcode_table)) / (sizeof (Boolean)));
690
branch_opcode_table[i] = FALSE;
693
i < ((sizeof (branch_opcodes)) / (sizeof (short)));
695
branch_opcode_table[branch_opcodes[i]] = TRUE;
697
instr.fields.opcode = 0x39; /* BLE opcode */
698
instr.fields.t_or_b = 03; /* scheme_to_interface_ble */
699
instr.fields.n = 01; /* nullify */
700
instr.fields.s = 01; /* C code space, rotated illegibly */
701
instr.fields.w0 = 00;
702
instr.fields.x_or_w1 = 00;
703
instr.fields.w2a = 00;
704
instr.fields.w2b = ((FAHRENHEIT + 1) >> 2);
706
bkpt_instruction = instr.inst;
708
instr.fields.w2b = ((FAHRENHEIT + 33) >> 2);
709
closure_entry_bkpt_instruction = instr.inst;
711
instr.fields.opcode = 0x38; /* BE opcode */
712
instr.fields.w2b = ((FAHRENHEIT + 9) >> 2);
713
closure_bkpt_instruction = instr.inst;
715
bkpt_normal_proceed_thunk
717
(C_closure_entry_point ((unsigned long) bkpt_normal_proceed)));
718
bkpt_plus_proceed_thunk
720
(C_closure_entry_point ((unsigned long) bkpt_plus_proceed)));
721
bkpt_minus_proceed_thunk_start
723
(C_closure_entry_point ((unsigned long) bkpt_minus_proceed_start)));
724
bkpt_minus_proceed_thunk
726
(C_closure_entry_point ((unsigned long) bkpt_minus_proceed)));
727
bkpt_closure_proceed_thunk
729
(C_closure_entry_point ((unsigned long) bkpt_closure_proceed)));
730
bkpt_closure_proceed_thunk_end
732
(C_closure_entry_point ((unsigned long) bkpt_closure_proceed_end)));
734
max_size = (bkpt_closure_proceed_thunk_end - bkpt_closure_proceed_thunk);
735
this_size = (bkpt_plus_proceed_thunk - bkpt_normal_proceed_thunk);
736
if (this_size > max_size)
737
max_size = this_size;
738
this_size = (bkpt_closure_proceed_thunk - bkpt_minus_proceed_thunk_start);
739
if (this_size > max_size)
740
max_size = this_size;
741
this_size = (bkpt_minus_proceed_thunk_start - bkpt_plus_proceed_thunk);
742
if (this_size > max_size)
743
max_size = this_size;
745
bkpt_proceed_buffer = ((unsigned long *)
746
(malloc (max_size * (sizeof (unsigned long)))));
747
if (bkpt_proceed_buffer == ((unsigned long *) NULL))
749
outf_fatal ("Unable to allocate the breakpoint buffer.\n");
750
termination_init_error ();
755
#define BKPT_KIND_CLOSURE 0
756
#define BKPT_KIND_NORMAL 1
757
#define BKPT_KIND_PC_REL_BRANCH 2
758
#define BKPT_KIND_BL_INST 3
759
#define BKPT_KIND_BLE_INST 4
760
#define BKPT_KIND_CLOSURE_ENTRY 5
762
extern void EXFUN (cache_flush_region, (PTR, long, unsigned int));
765
DEFUN (alloc_bkpt_handle, (kind, first_instr, entry_point),
766
int kind AND unsigned long first_instr AND PTR entry_point)
768
SCHEME_OBJECT * handle;
769
Primitive_GC_If_Needed (5);
773
handle[0] = (MAKE_OBJECT (TC_MANIFEST_VECTOR, 4));
774
handle[1] = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 2));
775
handle[2] = ((SCHEME_OBJECT) (FIXNUM_ZERO + kind));
776
handle[3] = ((SCHEME_OBJECT) first_instr);
777
handle[4] = (ENTRY_TO_OBJECT (entry_point));
779
return (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, handle));
783
DEFUN (bkpt_install, (entry_point), PTR entry_point)
786
SCHEME_OBJECT handle;
787
unsigned long first_instr = (* ((unsigned long *) entry_point));
788
unsigned short opcode = ((first_instr >> 26) & 0x3f);
789
unsigned long new_instr = bkpt_instruction;
791
if ((COMPILED_ENTRY_FORMAT_WORD (entry_point)) == FORMAT_WORD_CLOSURE)
793
/* This assumes that the first instruction is normal */
794
kind = BKPT_KIND_CLOSURE_ENTRY;
795
new_instr = closure_entry_bkpt_instruction;
797
else if ((! (branch_opcode_table[opcode])) || (opcode == 0x38))
798
kind = BKPT_KIND_NORMAL; /* BE instr included */
799
else if (opcode == 0x39)
801
kind = BKPT_KIND_BLE_INST;
805
else if (opcode != 0x3a)
807
unsigned long second_instr = (* (((unsigned long *) entry_point) + 1));
808
unsigned long second_opcode = ((second_instr >> 26) & 0x3f);
810
/* We can't handle breakpoints to a branch instruction
811
with another branch instruction in its delay slot.
812
This could be nullification sensitive, but not
813
currently worthwhile.
816
if (branch_opcode_table[second_opcode])
819
kind = BKPT_KIND_PC_REL_BRANCH;
824
union branch_inst finstr;
826
finstr.inst = first_instr;
827
switch (finstr.fields.s) /* minor opcode */
829
case 0: /* BL instruction */
831
kind = BKPT_KIND_BL_INST;
833
#endif /* for now, fall through */
835
case 1: /* GATE instruction */
836
case 2: /* BLR instruction */
841
kind = BKPT_KIND_NORMAL;
846
handle = (alloc_bkpt_handle (kind, first_instr, entry_point));
848
(* ((unsigned long *) entry_point)) = new_instr;
849
cache_flush_region (((PTR) entry_point), 1, (D_CACHE | I_CACHE));
855
DEFUN (bkpt_closure_install, (entry_point), PTR entry_point)
857
unsigned long * instrs = ((unsigned long *) entry_point);
858
SCHEME_OBJECT handle;
860
handle = (alloc_bkpt_handle (BKPT_KIND_CLOSURE, instrs[2], entry_point));
861
instrs[2] = closure_bkpt_instruction;
862
cache_flush_region (((PTR) &instrs[2]), 1, (D_CACHE | I_CACHE));
867
DEFUN (bkpt_remove, (entry_point, handle),
868
PTR entry_point AND SCHEME_OBJECT handle)
871
unsigned long * instrs = ((unsigned long *) entry_point);
873
if ((instrs[0] == bkpt_instruction)
874
|| (instrs[0] == closure_entry_bkpt_instruction))
876
else if (instrs[2] == closure_bkpt_instruction)
879
error_external_return ();
881
instrs[offset] = ((unsigned long) (FAST_MEMORY_REF (handle, 3)));
882
cache_flush_region (((PTR) &instrs[offset]), 1, (D_CACHE | I_CACHE));
887
DEFUN (bkpt_p, (entry_point), PTR entry_point)
889
unsigned long * instrs = ((unsigned long *) entry_point);
891
return ((instrs[0] == bkpt_instruction)
892
|| (instrs[0] == closure_entry_bkpt_instruction)
893
|| (instrs[2] == closure_bkpt_instruction));
897
DEFUN (do_bkpt_proceed, (value), unsigned long * value)
899
unsigned long * buffer = ((unsigned long *) bkpt_proceed_buffer);
900
SCHEME_OBJECT ep = (STACK_POP ());
901
SCHEME_OBJECT handle = (STACK_POP ());
902
SCHEME_OBJECT state = (STACK_POP ());
904
STACK_POP (); /* Pop duplicate entry point. */
906
switch (OBJECT_DATUM (FAST_MEMORY_REF (handle, 2)))
908
case BKPT_KIND_CLOSURE:
911
unsigned long * clos_entry
912
= (OBJECT_ADDRESS (FAST_MEMORY_REF (handle, 4)));
913
SCHEME_OBJECT real_entry_point;
915
EXTRACT_CLOSURE_ENTRY_ADDRESS (real_entry_point, clos_entry);
916
len = (bkpt_closure_proceed_thunk_end - bkpt_closure_proceed_thunk);
917
for (i = 0; i < (len - 2); i++)
918
buffer[i] = bkpt_closure_proceed_thunk[i];
919
cache_flush_region (((PTR) buffer), (len - 2), (D_CACHE | I_CACHE));
921
buffer[len - 2] = ((unsigned long) clos_entry);
922
buffer[len - 1] = real_entry_point;
925
* value = ((unsigned long) buffer);
929
case BKPT_KIND_NORMAL:
933
len = (bkpt_plus_proceed_thunk - bkpt_normal_proceed_thunk);
934
for (i = 0; i < (len - 2); i++)
935
buffer[i] = bkpt_normal_proceed_thunk[i];
936
buffer[len - 2] = ((unsigned long) (FAST_MEMORY_REF (handle, 3)));
938
cache_flush_region (((PTR) buffer), (len - 1), (D_CACHE | I_CACHE));
939
buffer[len - 1] = (((unsigned long) (OBJECT_ADDRESS (ep))) + 4);
942
* value = ((unsigned long) buffer);
946
case BKPT_KIND_CLOSURE_ENTRY:
948
STACK_PUSH (state); /* closure object */
949
* value = ((unsigned long) ((OBJECT_ADDRESS (ep)) + 2));
953
case BKPT_KIND_BL_INST:
954
case BKPT_KIND_BLE_INST:
957
* value = ((unsigned long) ERR_EXTERNAL_RETURN);
960
case BKPT_KIND_PC_REL_BRANCH:
964
union branch_inst new, old;
965
unsigned long * instrs = ((unsigned long *) (OBJECT_ADDRESS (ep)));
966
unsigned long * block;
968
old.inst = ((unsigned long) (FAST_MEMORY_REF (handle, 3)));
969
offset = (assemble_12 (old));
972
block = bkpt_plus_proceed_thunk;
973
len = (bkpt_minus_proceed_thunk_start - block);
978
block = bkpt_minus_proceed_thunk_start;
979
len = (bkpt_closure_proceed_thunk - block);
980
clobber = (bkpt_minus_proceed_thunk - block);
983
for (i = 0; i < (len - 2); i++)
984
buffer[i] = block[i];
986
new.inst = buffer[clobber];
987
old.inst = ((unsigned long) (FAST_MEMORY_REF (handle, 3)));
988
old.fields.w2b = new.fields.w2b;
989
old.fields.w2a = new.fields.w2a;
990
old.fields.w0 = new.fields.w0;
991
buffer[clobber] = old.inst;
992
buffer[clobber + 1] = instrs[1];
993
cache_flush_region (((PTR) buffer), (len - 2), (D_CACHE | I_CACHE));
995
buffer[len - 2] = (((unsigned long) instrs) + 8);
996
buffer[len - 1] = ((((unsigned long) instrs) + 8)
1000
* value = ((unsigned long) &buffer[clobber]);
1007
DEFUN (transform_procedure_entries, (len, otable, ntable),
1008
long len AND PTR * otable AND PTR * ntable)
1012
for (counter = 0; counter < len; counter++)
1014
((PTR) (C_closure_entry_point ((unsigned long) (otable [counter]))));
1019
DEFUN (transform_procedure_table, (table_length, old_table),
1020
long table_length AND PTR * old_table)
1024
new_table = ((PTR *) (malloc (table_length * (sizeof (PTR)))));
1025
if (new_table == ((PTR *) NULL))
1027
outf_fatal ("transform_procedure_table: malloc (%d) failed.\n",
1028
(table_length * (sizeof (PTR))));
1031
transform_procedure_entries (table_length, old_table, new_table);
1035
#define UTIL_TABLE_PC_REF(index) \
1036
(C_closure_entry_point (UTIL_TABLE_PC_REF_REAL (index)))
1039
# include <sys/mman.h>
1040
# define VM_PROT_SCHEME (PROT_READ | PROT_WRITE | PROT_EXEC)
1044
DEFUN_VOID (change_vm_protection)
1047
/* Thought I needed this under _BSD4_3 */
1049
unsigned long pagesize = (getpagesize ());
1050
unsigned long heap_start_page;
1053
heap_start_page = (((unsigned long) Heap) & (pagesize - 1));
1054
size = (((((unsigned long) Highest_Allocated_Address) + (pagesize - 1))
1057
if ((mprotect (((caddr_t) heap_start_page), size, VM_PROT_SCHEME))
1060
perror ("\nchange_vm_protection");
1061
outf_fatal ("mprotect (0x%lx, 0x%lx, 0x%lx)\n",
1062
heap_start_page, size, VM_PROT_SCHEME);
1063
outf_fatal ("ASM_RESET_HOOK: Unable to change VM protection of Heap.\n");
1064
termination_init_error ();
1072
#ifndef MODELS_FILENAME
1073
#define MODELS_FILENAME "hppacach.mod"
1076
static struct pdc_cache_dump cache_info;
1079
DEFUN_VOID (flush_i_cache_initialize)
1081
extern char * EXFUN (getenv, (const char *));
1082
CONST char * models_filename =
1083
(search_path_for_file (0, MODELS_FILENAME, 1, 1));
1086
model = (getenv ("MITSCHEME_HPPA_MODEL"));
1089
if (model == ((char *) NULL))
1091
struct utsname sysinfo;
1092
if ((uname (&sysinfo)) < 0)
1094
outf_fatal ("\nflush_i_cache: uname failed.\n");
1097
model = &sysinfo.machine[0];
1100
if (model == ((char *) NULL))
1103
("\nflush_i_cache: MITSCHEME_HPPA_MODEL not set in environment.\n");
1107
int fd = (open (models_filename, O_RDONLY));
1110
outf_fatal ("\nflush_i_cache: open (%s) failed.\n",
1118
((char *) (&cache_info)),
1119
(sizeof (struct pdc_cache_dump))));
1120
if (read_result == 0)
1125
if (read_result != (sizeof (struct pdc_cache_dump)))
1128
outf_fatal ("\nflush_i_cache: read (%s) failed.\n",
1132
if ((strcmp (model, (cache_info . hardware))) == 0)
1140
"The cache parameters database has no entry for the %s model.\n",
1142
outf_fatal ("Please make an entry in the database;\n");
1143
outf_fatal ("the installation notes contain instructions for doing so.\n");
1145
outf_fatal ("\nASM_RESET_HOOK: Unable to read cache parameters.\n");
1146
termination_init_error ();
1149
/* This loads the cache information structure for use by flush_i_cache,
1150
sets the floating point flags correctly, and accommodates the c
1151
function pointer closure format problems for utilities for HP-UX >= 8.0 .
1152
It also changes the VM protection of the heap, if necessary.
1155
extern PTR * hppa_utility_table;
1156
extern PTR * hppa_primitive_table;
1158
PTR * hppa_utility_table = ((PTR *) NULL);
1161
DEFUN (hppa_reset_hook, (utility_length, utility_table),
1162
long utility_length AND PTR * utility_table)
1164
extern void EXFUN (interface_initialize, (void));
1165
extern void EXFUN (cross_segment_call, (void));
1167
flush_i_cache_initialize ();
1168
interface_initialize ();
1169
change_vm_protection ();
1171
= (C_closure_entry_point ((unsigned long) cross_segment_call));
1173
= (transform_procedure_table (utility_length, utility_table));
1177
#define ASM_RESET_HOOK() do \
1180
hppa_reset_hook (((sizeof (utility_table)) / (sizeof (PTR))), \
1181
((PTR *) (&utility_table[0]))); \
1184
PTR * hppa_primitive_table = ((PTR *) NULL);
1187
DEFUN (hppa_update_primitive_table, (low, high), int low AND int high)
1189
transform_procedure_entries ((high - low),
1190
((PTR *) (Primitive_Procedure_Table + low)),
1191
(hppa_primitive_table + low));
1196
DEFUN (hppa_grow_primitive_table, (new_size), int new_size)
1199
= ((PTR *) (realloc (hppa_primitive_table, (new_size * (sizeof (PTR))))));
1200
if (new_table != ((PTR *) NULL))
1201
hppa_primitive_table = new_table;
1202
return (new_table != ((PTR *) NULL));
1206
Note: The following does not do a full decoding of the BLE instruction.
1207
It assumes that the bits have been set by STORE_ABSOLUTE_ADDRESS below,
1208
which decomposes an absolute address according to the `short_pointer'
1209
structure above, and thus certain fields are 0.
1211
The sequence inserted by STORE_ABSOLUTE_ADDRESS is approximately
1212
(the actual address decomposition is given above).
1218
DEFUN (hppa_extract_absolute_address, (addr), unsigned long * addr)
1220
union short_pointer result;
1221
union branch_inst ble;
1222
union ldil_inst ldil;
1224
ldil.inst = *addr++;
1227
/* Fill the padding */
1230
result.fields.A = ldil.fields.A;
1231
result.fields.B = ldil.fields.B;
1232
result.fields.C = ldil.fields.C;
1233
result.fields.D = ldil.fields.D;
1234
result.fields.w2a = ble.fields.w2a;
1235
result.fields.w2b = ble.fields.w2b;
1237
return (result.address);
1241
DEFUN (hppa_store_absolute_address, (addr, sourcev, nullify_p),
1242
unsigned long * addr AND unsigned long sourcev
1243
AND unsigned long nullify_p)
1245
union short_pointer source;
1246
union ldil_inst ldil;
1247
union branch_inst ble;
1249
source.address = sourcev;
1252
ldil.fields.opcode = 0x08;
1253
ldil.fields.base = 26;
1256
ldil.inst = ((0x08 << 26) | (26 << 21));
1259
ldil.fields.A = source.fields.A;
1260
ldil.fields.B = source.fields.B;
1261
ldil.fields.C = source.fields.C;
1262
ldil.fields.D = source.fields.D;
1265
ble.fields.opcode = 0x39;
1266
ble.fields.t_or_b = 26;
1267
ble.fields.x_or_w1 = 0;
1271
ble.inst = ((0x39 << 26) | (26 << 21) | (3 << 13));
1274
ble.fields.w2a = source.fields.w2a;
1275
ble.fields.w2b = source.fields.w2b;
1276
ble.fields.n = (nullify_p & 1);
1278
*addr++ = ldil.inst;
1283
/* Cache flushing/pushing code.
1284
Uses routines from cmpaux-hppa.m4.
1288
EXFUN (flush_i_cache, (void)),
1289
EXFUN (push_d_cache_region, (PTR, unsigned long));
1292
DEFUN_VOID (flush_i_cache)
1295
EXFUN (cache_flush_all, (unsigned int, struct pdc_cache_result *));
1297
struct pdc_cache_result * cache_desc;
1299
cache_desc = ((struct pdc_cache_result *) &(cache_info.cache_format));
1301
/* The call can be interrupted in the middle of a set, so do it twice.
1302
Probability of two interrupts in the same cache line is
1303
exceedingly small, so this is likely to win.
1304
On the other hand, if the caches are directly mapped, a single
1306
In addition, if the cache is shared, there is no need to flush at all.
1309
if (((cache_desc->I_info.conf.bits.fsel & 1) == 0)
1310
|| ((cache_desc->D_info.conf.bits.fsel & 1) == 0))
1312
unsigned int flag = 0;
1314
if (cache_desc->I_info.loop != 1)
1316
if (cache_desc->D_info.loop != 1)
1320
cache_flush_all (flag, cache_desc);
1321
cache_flush_all ((D_CACHE | I_CACHE), cache_desc);
1326
DEFUN (push_d_cache_region, (start_address, block_size),
1327
PTR start_address AND unsigned long block_size)
1330
EXFUN (cache_flush_region, (PTR, long, unsigned int));
1332
struct pdc_cache_result * cache_desc;
1334
cache_desc = ((struct pdc_cache_result *) &(cache_info.cache_format));
1336
/* Note that the first and last words are also flushed from the I-cache
1337
in case this object is adjacent to another that has already caused
1338
the cache line to be copied into the I-cache.
1341
if (((cache_desc->I_info.conf.bits.fsel & 1) == 0)
1342
|| ((cache_desc->D_info.conf.bits.fsel & 1) == 0))
1344
cache_flush_region (start_address, block_size, D_CACHE);
1345
cache_flush_region (start_address, 1, I_CACHE);
1346
cache_flush_region (((PTR)
1347
(((unsigned long *) start_address)
1348
+ (block_size - 1))),
1355
#define DECLARE_CMPINTMD_UTILITIES() \
1356
UTLD (assemble_17), \
1357
UTLD (assemble_12), \
1358
UTLD (C_closure_entry_point), \
1360
UTLD (alloc_bkpt_handle), \
1361
UTLD (bkpt_install), \
1362
UTLD (bkpt_closure_install), \
1363
UTLD (bkpt_remove), \
1365
UTLD (do_bkpt_proceed), \
1366
UTLD (transform_procedure_entries), \
1367
UTLD (transform_procedure_table), \
1368
UTLD (change_vm_protection), \
1369
UTLD (hppa_reset_hook), \
1370
UTLD (hppa_update_primitive_table), \
1371
UTLD (hppa_grow_primitive_table), \
1372
UTLD (hppa_extract_absolute_address), \
1373
UTLD (hppa_store_absolute_address), \
1374
UTLD (flush_i_cache), \
1375
UTLD (push_d_cache_region), \
1376
UTLD (flush_i_cache_initialize)
1378
#endif /* IN_CMPINT_C */
1380
#endif /* CMPINTMD_H_INCLUDED */