1 | /* Copyright (C) 2010 Clozure Associates */ |
---|
2 | /* Copyright (C) 1994-2001 Digitool, Inc */ |
---|
3 | /* This file is part of Clozure CL. */ |
---|
4 | |
---|
5 | /* Clozure CL is licensed under the terms of the Lisp Lesser GNU Public */ |
---|
6 | /* License , known as the LLGPL and distributed with Clozure CL as the */ |
---|
7 | /* file "LICENSE". The LLGPL consists of a preamble and the LGPL, */ |
---|
8 | /* which is distributed with Clozure CL as the file "LGPL". Where these */ |
---|
9 | /* conflict, the preamble takes precedence. */ |
---|
10 | |
---|
11 | /* Clozure CL is referenced in the preamble as the "LIBRARY." */ |
---|
12 | |
---|
13 | /* The LLGPL is also available online at */ |
---|
14 | /* http://opensource.franz.com/preamble.html */ |
---|
15 | |
---|
16 | |
---|
17 | /* As of the 2005 edition of the ARM Architecture Reference Manual */ |
---|
18 | /* ("ARM ARM"), instructions I for which: */ |
---|
19 | /* (logand i (logior (ash 255 20) (ash 15 4))) = */ |
---|
20 | /* (logior (ash 127 20) (ash 15 4)) is true are considered */ |
---|
21 | /* "architecturally undefined", e.g., unlikely to be implemented on */ |
---|
22 | /* future versions of the architecture. I haven't seen anything that */ |
---|
23 | /* supersedes or contradicts this, but I'm not entirely sure that I would. */ |
---|
24 | |
---|
25 | uuo_base_opcode = ((127<<20)|(15<<4)) |
---|
26 | |
---|
27 | /* Like most 32-bit ARM instructions, these instructions are only executed */ |
---|
28 | /* (and therefore only raise exceptions) if their condition field (in bits */ |
---|
29 | /* 28:31) is true. We also have a 12-bit field at bit 20 and a 4-bit field */ |
---|
30 | /* at bit 0 in which to encode variable information. This encoding uses */ |
---|
31 | /* the 4-bit field to describe the format of the 12-bit field, which can */ |
---|
32 | /* encode 12 bits of "error code", or 8 bits of code and a 4 bit register */ |
---|
33 | /* number, or 4 bits of code and 2 4-bit register numbers. */ |
---|
34 | |
---|
35 | uuo_format_nullary = 0 /* 12 bits of code */ |
---|
36 | uuo_format_unary = 1 /* 8 bits of info - NOT type info - 4-bit reg */ |
---|
37 | uuo_format_error_lisptag = 2 /* 2 bits of lisptag info, 4-bit reg */ |
---|
38 | uuo_format_error_fulltag = 3 /* 3 bits of fulltag info, 4 bit reg */ |
---|
39 | |
---|
40 | uuo_format_error_xtype = 4 /* 8 bits of extended type/subtag info, 4 bit reg */ |
---|
41 | uuo_format_binary = 7 /* 4 bits of code, r1, r0 */ |
---|
42 | uuo_format_nullary_error = 8 /* nullary, call out to lisp */ |
---|
43 | uuo_format_unary_error = 9 /* like unary, but call out to lisp */ |
---|
44 | uuo_format_cerror_lisptag = 10 /* continuable, lisptag, reg */ |
---|
45 | uuo_format_cerror_fulltag = 11 /* continuable, fulltag, reg */ |
---|
46 | uuo_format_cerror_xtype = 12 /* continuable, xtype, reg */ |
---|
47 | uuo_format_kernel_service = 13 /* 8 bits of info */ |
---|
48 | uuo_format_ternary_error = 14 /* SLOT-UNBOUND only */ |
---|
49 | uuo_format_binary_error = 15 /* binary format, call out to lisp */ |
---|
50 | |
---|
51 | /* Encode a UUO with cond = $1, format = $2, info = $3 */ |
---|
52 | define(`UUO',` |
---|
53 | .word (uuo_base_opcode|($1<<28)|$2|($3<<8)) |
---|
54 | ') |
---|
55 | /* Nullary UUO with cond = $1, info = $2 */ |
---|
56 | define(`nullaryUUO',`UUO($1,uuo_format_nullary,$2)') |
---|
57 | define(`nullary_errorUUO',`UUO($1,uuo_format_nullary_error,$2)') |
---|
58 | /* Simple (non-TYPE) unary uuo with cond = $1, reg = $2, info = $3 */ |
---|
59 | define(`unaryUUO',`UUO($1,uuo_format_unary,($2|($3<<4)))') |
---|
60 | define(`unary_errorUUO',`UUO($1,uuo_format_unary_error,($2|($3<<4)))') |
---|
61 | |
---|
62 | define(`binaryUUO',`UUO($1,uuo_format_binary,($2|($3<<4)|($4<<8)))') |
---|
63 | define(`binary_errorUUO',`UUO($1,uuo_format_binary_error,($2|($3<<4)|($4<<8)))') |
---|
64 | |
---|
65 | /* Simple type error (reg not lisptag), cond = $1, reg = $2, lisptag = $3 */ |
---|
66 | define(`uuo_error_reg_not_lisptag',`UUO($1,uuo_format_error_lisptag,$2|($3<<4))') |
---|
67 | /* Likewise, for fulltag. (Can distinguish between tag_list/fulltag_cons) */ |
---|
68 | define(`uuo_error_reg_not_fulltag',`UUO($1,uuo_format_error_fulltag,$2|($3<<4))') |
---|
69 | /* As used here, an 'xtype' is an 8-bit value that's either a defined */ |
---|
70 | /* subtag/tag/lisptag value or some encoding of something like 'integer' */ |
---|
71 | define(`uuo_error_reg_not_xtype',`UUO($1,uuo_format_error_xtype,$2|($3<<4))') |
---|
72 | /* Continuable type errors */ |
---|
73 | define(`uuo_cerror_reg_not_lisptag',`UUO($1,uuo_format_cerror_lisptag,$2|($3<<4))') |
---|
74 | define(`uuo_cerror_reg_not_fulltag',`UUO($1,uuo_format_cerror_fulltag,$2|($3<<4))') |
---|
75 | define(`uuo_cerror_reg_not_xtype',`UUO($1,uuo_format_cerror_xtype,$2|($3<<4))') |
---|
76 | |
---|
77 | /* Nullary UUOs. Define them as being conditional, even if the condition is */ |
---|
78 | /* 'al' (always). $1=cond, $2=8-bit-code */ |
---|
79 | define(`uuo_alloc_trap',`nullaryUUO($1,0)') |
---|
80 | define(`uuo_error_wrong_nargs',`nullary_errorUUO($1,1)') /* can use CC field */ |
---|
81 | define(`uuo_gc_trap',`nullaryUUO($1,2)') /* probably unconditional */ |
---|
82 | define(`uuo_debug_trap',`nullaryUUO($1,3)') |
---|
83 | define(`uuo_interrupt_now',`nullaryUUO($1,4)') |
---|
84 | define(`uuo_suspend_now',`nullaryUUO($1,5)') |
---|
85 | define(`uuo_stack_overflow_recovery',`nullaryUUO($1,6)') |
---|
86 | |
---|
87 | /* Unary UUOs */ |
---|
88 | define(`uuo_error_unbound',`unary_errorUUO($1,$2,0)') |
---|
89 | define(`uuo_cerror_unbound',`unary_errorUUO($1,$2,1)') |
---|
90 | define(`uuo_error_not_callable',`unary_errorUUO($1,$2,2)') |
---|
91 | define(`uuo_tlb_too_small',`unaryUUO($1,$2,3)') |
---|
92 | define(`uuo_error_no_throw_tag',`unary_errorUUO($1,$2,4)') |
---|
93 | define(`uuo_error_udf_call',`unary_errorUUO($1,$2,5)') |
---|
94 | define(`uuo_error_udf',`unary_errorUUO($1,$2,6)') |
---|
95 | |
---|
96 | /* Binary UUOs */ |
---|
97 | define(`uuo_error_vector_bounds',`binary_errorUUO($1,$2,$3,0)') |
---|
98 | define(`uuo_error_array_bounds',`binary_errorUUO($1,$2,$3,1)') |
---|
99 | define(`uuo_error_integer_divide_by_zero',`binary_errorUUO($1,$2,$3,2)') |
---|
100 | define(`uuo_error_slot_unbound',`binary_errorUUO($1,$2,$3,3)') |
---|
101 | define(`uuo_error_eep_unresolved',`binary_errorUUO($1,$2,$3,4)') |
---|
102 | define(`uuo_error_fpu_exception',`binary_errorUUO($1,$2,$3,5)') |
---|
103 | define(`uuo_error_array_rank',`binary_errorUUO($1,$2,$3,6)') |
---|
104 | define(`uuo_error_array_flags',`binary_errorUUO($1,$2,$3,7)') |
---|
105 | |
---|
106 | /* This should never be generated (never be a legal instruction in a code |
---|
107 | vector); it should only be used by purify/impurify. */ |
---|
108 | define(`forward_marker',`uuo(al,uuo_format_unary,0xfff)') |
---|
109 | |
---|