annotate keiko/keiko.iset @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
2 # keiko.iset
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
3 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
4 # This file is part of the Oxford Oberon-2 compiler
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5 # Copyright (c) 2006--2016 J. M. Spivey
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6 # All rights reserved
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8 # Redistribution and use in source and binary forms, with or without
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9 # modification, are permitted provided that the following conditions are met:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
10 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
11 # 1. Redistributions of source code must retain the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12 # this list of conditions and the following disclaimer.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13 # 2. Redistributions in binary form must reproduce the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 # this list of conditions and the following disclaimer in the documentation
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 # and/or other materials provided with the distribution.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 # 3. The name of the author may not be used to endorse or promote products
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17 # derived from this software without specific prior written permission.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 # OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 # OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 # ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29 #
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32 #define local(n) ((uchar *) bp + (n))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33 #define parent(a, t) indir(pointer(bp[SL]) + a, t)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34 #define indir(p, t) (* (t *) (p))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35 #define subs(p, n, t) ((t *) (p))[n]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36 #define const(n) cp[CP_CONST+n]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 #define jump(lab) pc = pc0 + lab
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41 # CONSTANTS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43 inst PUSH {[-1,6,1] 1 2} V.i {$a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44 inst LDKW {1 2} V.i {const($a).i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45 inst LDKF {1 2} V.f {const($a).f}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48 # ADDRESSING OPERATORS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50 # Push address of local
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51 # LOCAL n :: --> bp+n
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52 inst LOCAL {1 2} V.x {local($a)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54 # Compute indexed address
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55 # INDEXs :: a, b --> a + s * b
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 inst OFFSET 0 B.x {pointer($1) + $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57 inst INDEXS 0 B.x {pointer($1) + ($2.i<<1)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58 inst INDEXW 0 B.x {pointer($1) + ($2.i<<2)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59 inst INDEXD 0 B.x {pointer($1) + ($2.i<<3)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62 # LOADS AND STORES
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64 # Load/store from address
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65 # LOADs :: a --> mem_s[a]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 # STOREs :: a, b --> []; mem_s[b] := a
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67 inst LOADW 0 M.i {indir(pointer($1), int)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68 inst LOADS 0 M.i {indir(pointer($1), short)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69 inst LOADC 0 M.i {indir(pointer($1), uchar)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70 inst LOADF 0 M.f {indir(pointer($1), float)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71 inst STOREW 0 S2 {indir(pointer($2), int) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72 inst STORES 0 S2 {indir(pointer($2), short) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73 inst STOREC 0 S2 {indir(pointer($2), uchar) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 inst STOREF 0 S2 {indir(pointer($2), float) = $1.f;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 # Load/store local
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 # LDLs n :: --> mem_s[bp+n]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78 # STLs n :: a --> []; mem_s[bp+n] := a
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79 inst LDLW {[-24,-4,4] [12,32,4] 1 2} \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80 V.i {indir(local($a), int)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81 inst LDLS {1 2} V.i {indir(local($a), short)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82 inst LDLC {1 2} V.i {indir(local($a), uchar)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83 inst LDLF {1 2} V.f {indir(local($a), float)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 inst STLW {[-24,-4,4] [12,32,4] 1 2} \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85 S1 {indir(local($a), int) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86 inst STLS {1 2} S1 {indir(local($a), short) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87 inst STLC {1 2} S1 {indir(local($a), uchar) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 inst STLF {1 2} S1 {indir(local($a), float) = $1.f;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90 # Load/store global
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 # LDGs n :: --> mem_s[const(n)]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 # STGs n :: a --> []; mem_s[const(n)] := a
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 inst LDGW {K L} V.i {indir(pointer(const($a)), int)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
94 inst LDGS {K L} V.i {indir(pointer(const($a)), short)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
95 inst LDGC {K L} V.i {indir(pointer(const($a)), uchar)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
96 inst LDGF {K L} V.f {indir(pointer(const($a)), float)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
97 inst STGW {K L} S1 {indir(pointer(const($a)), int) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
98 inst STGS {K L} S1 {indir(pointer(const($a)), short) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
99 inst STGC {K L} S1 {indir(pointer(const($a)), uchar) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
100 inst STGF {K L} S1 {indir(pointer(const($a)), float) = $1.f;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
101
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
102 # Indexed load/store
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
103 # LDNs n :: a -> mem_s[a+n]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
104 # STNs n :: a, b -> []; mem_s[b+n] := a
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
105 inst LDNW {[-16,40,4] 1 2} M.i {indir(pointer($1) + $a, int)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
106 inst STNW {[-16,20,4] 1 2} S2 {indir(pointer($2) + $a, int) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
107
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
108 # Double indexed load/store
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
109 # LDIs :: a, b --> mem_s[a+s*b]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
110 # STIs :: a, b, c --> []; mem_s[b+s*c] := a
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
111 inst LDIW 0 B.i {subs(pointer($1), $2.i, int)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
112 inst LDIF 0 B.f {subs(pointer($1), $2.i, float)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
113 inst LDIS 0 B.i {subs(pointer($1), $2.i, short)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
114 inst LDIC 0 B.i {subs(pointer($1), $2.i, uchar)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
115 inst STIW 0 S3 {subs(pointer($2), $3.i, int) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
116 inst STIF 0 S3 {subs(pointer($2), $3.i, float) = $1.f;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
117 inst STIS 0 S3 {subs(pointer($2), $3.i, short) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
118 inst STIC 0 S3 {subs(pointer($2), $3.i, uchar) = $1.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
119
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
120 inst LDID 0 B.dpi \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
121 {getdbl((value *) &subs(pointer($1), $2.i, double))}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
122 inst STID 0 S3dpi \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
123 {putdbl((value *) &subs(pointer($2), $3.i, double), $1.d);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
124
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
125 inst LDIQ 0 B.qpi \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
126 {getlong((value *) &subs(pointer($1), $2.i, longint))}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
127 inst STIQ 0 S3qpi \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
128 {putlong((value *) &subs(pointer($2), $3.i, longint), $1.q);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
129
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
130 # If the argument of any of the above instructions is so large that it
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
131 # does not fit in two bytes, then it's the job of the compiler to find
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
132 # an equivalent sequence using LDKW that achieves the same effect:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
133 # for example, LDLW n --> LDKW [n] / LOADW
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
134
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
135 # Loads and stores for doubles
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
136 inst LOADD 0 M.dp {getdbl(valptr($1))}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
137 inst STORED 0 S2dp {putdbl(valptr($2), $1.d);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
138 inst LDKD {1 2} V.d {getdbl(&const($a))}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
139
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
140 inst LOADQ 0 M.qp {getlong(valptr($1))}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
141 inst STOREQ 0 S2qp {putlong(valptr($2), $1.q);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
142 inst LDKQ {1 2} V.q {getlong(&const($a))}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
143
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
144 equiv LDLD 1 {LOCAL $a, LOADD}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
145 equiv STLD 1 {LOCAL $a, STORED}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
146 equiv LDGD K {LDKW $a, LOADD}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
147 equiv STGD K {LDKW $a, STORED}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
148
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
149 equiv LDLQ 1 {LOCAL $a, LOADQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
150 equiv STLQ 1 {LOCAL $a, STOREQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
151 equiv LDGQ K {LDKW $a, LOADQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
152 equiv STGQ K {LDKW $a, STOREQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
153
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
154 # ASSORTED INSTRUCTIONS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
155
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
156 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
157 #define dup(n, sp) sp--; sp[0] = sp[n+1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
158 #define swap(sp) sp[-1] = sp[1]; sp[1] = sp[0]; sp[0] = sp[-1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
159 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
160 inst INCL 1 S0 {indir(local($a), int)++;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
161 inst DECL 1 S0 {indir(local($a), int)--;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
162 inst DUP {[0,2,1]} S0 {dup($a, $s);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
163 inst SWAP 0 S0 {swap($s);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
164 inst POP 1 S0 {sp += $a;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
165
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
166 equiv INCL 2 {LDLW $a, INC, STLW $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
167 equiv DECL 2 {LDLW $a, DEC, STLW $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
168
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
169
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
170 # INTEGER OPERATORS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
171
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
172 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
173 #define ror(a, b) ((((unsigned) a) >> b) | (((unsigned) a) << (32-b)))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
174 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
175 inst PLUS 0 B.i {$1.i + $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
176 inst MINUS 0 B.i {$1.i - $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
177 inst TIMES 0 B.i {$1.i * $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
178 inst UMINUS 0 M.i {- $1.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
179 inst AND 0 B.i {$1.i && $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
180 inst OR 0 B.i {$1.i || $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
181 inst NOT 0 M.i {! $1.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
182 inst INC 0 M.i {$1.i + 1}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
183 inst DEC 0 M.i {$1.i - 1}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
184 inst BITAND 0 B.i {$1.i & $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
185 inst BITOR 0 B.i {$1.i | $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
186 inst BITXOR 0 B.i {$1.i ^ $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
187 inst BITNOT 0 M.i {~ $1.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
188 inst LSL 0 B.i {$1.i << $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
189 inst LSR 0 B.i {((unsigned) $1.i) >> $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
190 inst ASR 0 B.i {$1.i >> $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
191 inst ROR 0 B.i {ror($1.i, $2.i)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
192
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
193 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
194 /* The DIV and MOD instructions must give the correct results, even if
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
195 C is wrong. Correct means that b * (a DIV b) + a MOD b = a, and
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
196 (-a) DIV (-b) = a DIV b, and if b > 0 then 0 <= a MOD b < b. */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
197
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
198 static inline divop_decl(int)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
199 static inline divop_decl(longint)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
200 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
201
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
202 inst DIV 0 B.i {int_divop($1.i, $2.i, 1)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
203 inst MOD 0 B.i {int_divop($1.i, $2.i, 0)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
204
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
205 inst EQ 0 B.i {$1.i == $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
206 inst LT 0 B.i {$1.i < $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
207 inst GT 0 B.i {$1.i > $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
208 inst LEQ 0 B.i {$1.i <= $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
209 inst GEQ 0 B.i {$1.i >= $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
210 inst NEQ 0 B.i {$1.i != $2.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
211
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
212 inst JEQ {S R} S2 {if ($1.i == $2.i) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
213 inst JLT {S R} S2 {if ($1.i < $2.i) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
214 inst JGT {S R} S2 {if ($1.i > $2.i) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
215 inst JLEQ {S R} S2 {if ($1.i <= $2.i) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
216 inst JGEQ {S R} S2 {if ($1.i >= $2.i) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
217 inst JNEQ {S R} S2 {if ($1.i != $2.i) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
218
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
219 inst JLTZ S S1 {if ($1.i < 0) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
220 inst JGTZ S S1 {if ($1.i > 0) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
221 inst JLEQZ S S1 {if ($1.i <= 0) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
222 inst JGEQZ S S1 {if ($1.i >= 0) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
223
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
224 equiv JLTZ R {PUSH 0, JLT $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
225 equiv JGTZ R {PUSH 0, JGT $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
226 equiv JLEQZ R {PUSH 0, JLEQ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
227 equiv JGEQZ R {PUSH 0, JGEQ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
228
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
229 inst JNEQZ {S R} S1 {if ($1.i != 0) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
230 inst JEQZ {S R} S1 {if ($1.i == 0) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
231 inst JUMP {S R} S0 {jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
232
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
233 # LONGINT OPERATORS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
234
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
235 inst QPLUS 0 B.q {$1.q + $2.q}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
236 inst QMINUS 0 B.q {$1.q - $2.q}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
237 inst QTIMES 0 B.q {$1.q * $2.q}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
238 inst QUMINUS 0 M.q {- $1.q}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
239 inst QDIV 0 B.q {longint_divop($1.q, $2.q, 1)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
240 inst QMOD 0 B.q {longint_divop($1.q, $2.q, 0)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
241
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
242 equiv QINC 0 {PUSH 1, CONVNQ, QPLUS}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
243 equiv QDEC 0 {PUSH 1, CONVNQ, QMINUS}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
244
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
245
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
246 # CASE STATEMENTS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
247
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
248 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
249 #define jcase(x, n) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
250 if ((unsigned) x < (unsigned) n) { pc0 = pc + 2*x; jump(get2(pc0)); } \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
251 else pc += 2*n
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
252 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
253 inst JCASE 1 S1 {jcase($1.i, $a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
254 zinst CASEL R
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
255
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
256 inst JRANGE {S R} S3 {if ($1.i >= $2.i && $1.i <= $3.i) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
257
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
258 # The "T2" means take two arguments, but leave one of them on the stack
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
259 inst TESTGEQ {S R} T2 {if ($1.i >= $2.i) jump($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
260
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
261
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
262 # FLOATING-POINT OPERATORS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
263
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
264 inst FPLUS 0 B.f {$1.f + $2.f}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
265 inst FMINUS 0 B.f {$1.f - $2.f}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
266 inst FTIMES 0 B.f {$1.f * $2.f}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
267 inst FDIV 0 B.f {$1.f / $2.f}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
268 inst FUMINUS 0 M.f {- $1.f}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
269
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
270 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
271 static inline int fcmpl(double a, double b) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
272 return (a > b ? 1 : a == b ? 0 : -1);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
273 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
274
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
275 static inline int fcmpg(double a, double b) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
276 return (a < b ? -1 : a == b ? 0 : 1);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
277 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
278
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
279 static inline int lcmp(longint a, longint b) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
280 return (a < b ? -1 : a > b ? 1 : 0);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
281 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
282 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
283
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
284 inst FCMPL 0 B.i {fcmpl($1.f, $2.f)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
285 inst FCMPG 0 B.i {fcmpg($1.f, $2.f)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
286
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
287 equiv FEQ 0 {FCMPL, PUSH 0, EQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
288 equiv FNEQ 0 {FCMPL, PUSH 0, NEQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
289 equiv FLT 0 {FCMPG, PUSH 0, LT}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
290 equiv FGT 0 {FCMPL, PUSH 0, GT}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
291 equiv FLEQ 0 {FCMPG, PUSH 0, LEQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
292 equiv FGEQ 0 {FCMPL, PUSH 0, GEQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
293
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
294 # The floating-point conditional jumps are just shorthand for a
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
295 # comparison and an integer jump. This saves valuable opcodes for more
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
296 # important functions.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
297 equiv FJEQ R {FCMPL, JEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
298 equiv FJNEQ R {FCMPL, JNEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
299 equiv FJLT R {FCMPG, JLTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
300 equiv FJGT R {FCMPL, JGTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
301 equiv FJLEQ R {FCMPG, JLEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
302 equiv FJGEQ R {FCMPL, JGEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
303 equiv FJNLT R {FCMPG, JGEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
304 equiv FJNGT R {FCMPL, JLEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
305 equiv FJNLEQ R {FCMPG, JGTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
306 equiv FJNGEQ R {FCMPL, JLTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
307
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
308 # DOUBLE-PRECISION OPERATORS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
309
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
310 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
311 #ifdef UNALIGNED_MEM
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
312 #define getdbl get_double
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
313 #define putdbl put_double
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
314 #define getlong get_long
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
315 #define putlong put_long
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
316 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
317 static inline double getdbl(value *v) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
318 dblbuf dd;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
319 dd.n.lo = v[0].i;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
320 dd.n.hi = v[1].i;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
321 return dd.d;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
322 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
323
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
324 static inline void putdbl(value *v, double x) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
325 dblbuf dd;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
326 dd.d = x;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
327 v[0].i = dd.n.lo;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
328 v[1].i = dd.n.hi;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
329 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
330
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
331 static inline longint getlong(value *v) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
332 dblbuf dd;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
333 dd.n.lo = v[0].i;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
334 dd.n.hi = v[1].i;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
335 return dd.q;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
336 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
337
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
338 static inline void putlong(value *v, longint x) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
339 dblbuf dd;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
340 dd.q = x;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
341 v[0].i = dd.n.lo;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
342 v[1].i = dd.n.hi;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
343 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
344 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
345 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
346
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
347 inst DPLUS 0 B.d {$1.d + $2.d}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
348 inst DMINUS 0 B.d {$1.d - $2.d}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
349 inst DTIMES 0 B.d {$1.d * $2.d}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
350 inst DDIV 0 B.d {$1.d / $2.d}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
351 inst DUMINUS 0 M.d {- $1.d}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
352
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
353 inst DCMPL 0 B.idd {fcmpl($1.d, $2.d)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
354 inst DCMPG 0 B.idd {fcmpg($1.d, $2.d)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
355
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
356 equiv DEQ 0 {DCMPL, PUSH 0, EQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
357 equiv DNEQ 0 {DCMPL, PUSH 0, NE}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
358 equiv DLT 0 {DCMPG, PUSH 0, LT}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
359 equiv DGT 0 {DCMPL, PUSH 0, GT}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
360 equiv DLEQ 0 {DCMPG, PUSH 0, LE}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
361 equiv DGEQ 0 {DCMPL, PUSH 0, GE}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
362
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
363 equiv DJEQ R {DCMPL, JEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
364 equiv DJNEQ R {DCMPL, JNEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
365 equiv DJLT R {DCMPG, JLTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
366 equiv DJGT R {DCMPL, JGTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
367 equiv DJLEQ R {DCMPG, JLEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
368 equiv DJGEQ R {DCMPL, JGEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
369 equiv DJNLT R {DCMPG, JGEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
370 equiv DJNGT R {DCMPL, JLEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
371 equiv DJNLEQ R {DCMPG, JGTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
372 equiv DJNGEQ R {DCMPL, JLTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
373
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
374 inst QCMP 0 B.iqq {lcmp($1.q, $2.q)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
375
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
376 equiv QEQ 0 {QCMP, PUSH 0, EQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
377 equiv QLT 0 {QCMP, PUSH 0, LT}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
378 equiv QGT 0 {QCMP, PUSH 0, GT}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
379 equiv QLEQ 0 {QCMP, PUSH 0, LEQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
380 equiv QGEQ 0 {QCMP, PUSH 0, GEQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
381 equiv QNEQ 0 {QCMP, PUSH 0, NEQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
382
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
383 equiv QJEQ R {QCMP, JEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
384 equiv QJLT R {QCMP, JLTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
385 equiv QJGT R {QCMP, JGTZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
386 equiv QJLEQ R {QCMP, JLEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
387 equiv QJGEQ R {QCMP, JGEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
388 equiv QJNEQ R {QCMP, JNEQZ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
389
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
390
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
391 # CONVERSIONS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
392
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
393 inst CONVNF 0 M.f {flo_conv($1.i)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
394 inst CONVND 0 M.di {flo_conv($1.i)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
395 inst CONVFN 0 M.i {(int) $1.f}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
396 inst CONVDN 0 M.id {(int) $1.d}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
397 inst CONVFD 0 M.df {$1.f}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
398 inst CONVDF 0 M.fd {(float) $1.d}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
399 inst CONVNC 0 M.i {$1.i & 0xff}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
400 inst CONVNS 0 M.i {(short) $1.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
401 inst CONVNQ 0 M.qi {$1.i}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
402 inst CONVQN 0 M.iq {(int) $1.q}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
403 inst CONVQD 0 M.dq {flo_convq($1.q)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
404
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
405
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
406 # RUN-TIME CHECKS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
407
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
408 # The operand of these checks is the line number to show in the error
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
409 # message. God forbid people should make source files containing
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
410 # more than 65536 lines
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
411
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
412 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
413 static inline int boundcheck(unsigned i, unsigned n, int line,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
414 value *bp, uchar *pc) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
415 if (i >= n) runtime_error(E_BOUND, line, bp, pc);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
416 return i;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
417 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
418
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
419 #define checkdef(name, type, arg, extra, test, msg) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
420 static inline type name(type arg extra, int line, \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
421 value *bp, uchar *pc) { \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
422 if (test) runtime_error(msg, line, bp, pc); \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
423 return arg; \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
424 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
425
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
426 checkdef(nullcheck, uchar *, p,, p == NULL, E_NULL)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
427 checkdef(zerocheck, int, n,, n == 0, E_DIV)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
428 checkdef(fzerocheck, double, x,, x == 0.0, E_FDIV)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
429 checkdef(lzerocheck, longint, n,, n == 0, E_DIV)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
430 checkdef(globcheck, value *, p,, p != NULL, E_GLOB)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
431
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
432 #define czech(chk, a, n) chk(a, n, bp, pc0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
433 #define czech2(chk, a, b, n) chk(a, b, n, bp, pc0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
434 #define error(msg, n) runtime_error(msg, n, bp, pc0);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
435 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
436
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
437 inst BOUND 2 B.i {czech2(boundcheck, $1.i, $2.i, $a)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
438 inst NCHECK 2 M.x {czech(nullcheck, pointer($1), $a)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
439 inst GCHECK 2 S1 {czech(globcheck, valptr($1), $a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
440 inst ZCHECK 2 M.i {czech(zerocheck, $1.i, $a)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
441 inst FZCHECK 2 M.f {czech(fzerocheck, $1.f, $a)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
442 inst DZCHECK 2 M.d {czech(fzerocheck, $1.d, $a)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
443 inst QZCHECK 2 M.q {czech(lzerocheck, $1.q, $a)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
444 inst ERROR 12 S0 {error($a, $b);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
445 equiv EASSERT 2 {RESULTW, ERROR E_ASSERT $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
446
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
447
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
448 # MORE BITS AND PIECES
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
449
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
450 # ALIGNs instructions are used on big-endian machines like the SPARC
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
451 # to ensure that CHAR and SHORT parameters appear at the right address.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
452 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
453 #ifdef WORDS_BIGENDIAN
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
454 #define alignx(a, n) (a <<= (32-n))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
455 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
456 #define alignx(a, n) a
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
457 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
458 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
459 inst ALIGNC 0 M.i {alignx($1.i, 8)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
460 inst ALIGNS 0 M.i {alignx($1.i, 16)}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
461
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
462 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
463 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
464 #define prof_charge(n) ticks += n
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
465 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
466 #define prof_charge(n)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
467 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
468 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
469
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
470 # FIXCOPY copies a fixed number of bytes; it is used for structure
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
471 # assignment and also for value parameters of (fixed) array or record type. */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
472 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
473 #define fixcopy(a, b, n) prof_charge(n/4); memcpy(a, b, n)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
474 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
475 inst FIXCOPY 0 S3 {fixcopy(pointer($1), pointer($2), $3.i);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
476
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
477 # FLEXCOPY expects to find on the stack the address of a flex array parameter
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
478 # and a size in bytes; it copies the parameter to dynamic local space,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
479 # then overwrites the parameter with the new address.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
480 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
481 #define flexcopy(d0, size0) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
482 { value *d = (value *) d0; int size = size0; \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
483 int sizew = (size+3)/4; prof_charge(sizew); \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
484 sp -= sizew; \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
485 if ((uchar *) sp < stack + SLIMIT) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
486 error(E_STACK, 0); \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
487 memcpy(sp, pointer(d[0]), size); \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
488 d[0].a = address(sp);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
489 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
490 inst FLEXCOPY 0 S2 {flexcopy(pointer($1), $2.i);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
491
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
492 # In the interpreter, the CALLW and CALLD instructions are implemented as
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
493 # two operations, an ordinary CALL followed by a SLIDE; the return address
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
494 # of the called routine points to the SLIDE instruction, which is
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
495 # responsible for copying the result.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
496 equiv CALL 1 {JPROC, SLIDE $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
497 equiv CALLW 1 {JPROC, SLIDEW $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
498 equiv CALLQ 1 {JPROC, SLIDEQ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
499 equiv CALLF 1 {JPROC, SLIDEF $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
500 equiv CALLD 1 {JPROC, SLIDED $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
501
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
502 inst LINK 0 S1 {statlink = valptr($1);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
503 inst SAVELINK 0 S0 {bp[SL].a = address(statlink);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
504
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
505 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
506 #define frame() \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
507 bp = sp; \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
508 sp = (value *) ((uchar *) bp - cp[CP_FRAME].i); \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
509 if ((uchar *) sp < stack + SLIMIT) error(E_STACK, 0); \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
510 memset(sp, 0, cp[CP_FRAME].i);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
511
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
512 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
513 #define cond_break() \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
514 if (one_shot && *pc != K_LNUM_2 && *pc != K_BREAK_2) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
515 debug_break(cp, bp, pc, "stop")
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
516 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
517 #define cond_break()
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
518 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
519 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
520
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
521 inst JPROC 0 S0 {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
522 value *p = valptr(sp[0]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
523 sp -= HEAD-1; sp[BP].a = address(bp); sp[PC].a = address(pc);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
524 if (! interpreted(p)) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
525 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
526 /* Calling a native-code routine */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
527 prof_enter(p, ticks, PROF_PRIM);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
528 ticks = 0;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
529 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
530 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
531 prim_bp = sp;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
532 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
533 primcall(p, sp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
534 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
535 prim_bp = NULL;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
536 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
537 } else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
538 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
539 prof_enter(p, ticks, PROF_CALL);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
540 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
541 cp = p; pc = pointer(cp[CP_CODE]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
542 do_find_proc;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
543 frame();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
544 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
545 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
546
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
547 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
548 #define slide(nargs) sp += HEAD + nargs; cond_break();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
549 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
550
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
551 inst SLIDE 1 S0 {slide($a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
552 inst SLIDEW 1 S0 {slide($a); sp--; sp[0].i = ob_res.i;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
553 inst SLIDED 1 S0 {slide($a); sp -= 2;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
554 putdbl(&sp[0], getdbl(&ob_res));}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
555 inst SLIDEF 1 S0 {slide($a); sp--; sp[0].f = ob_res.f;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
556 inst SLIDEQ 1 S0 {slide($a); sp -= 2;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
557 putlong(&sp[0], getlong(&ob_res));}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
558
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
559 equiv RETURNW 0 {RESULTW, RETURN}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
560 equiv RETURNF 0 {RESULTF, RETURN}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
561 equiv RETURND 0 {RESULTD, RETURN}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
562 equiv RETURNQ 0 {RESULTQ, RETURN}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
563
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
564 inst RESULTW 0 S1 {ob_res = $1;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
565 inst RESULTD 0 S1d {putdbl(&ob_res, $1.d);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
566 inst RESULTF 0 S1 {ob_res.f = $1.f;}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
567 inst RESULTQ 0 S1q {putlong(&ob_res, $1.q);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
568
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
569 inst RETURN 0 S0 {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
570 if (bp == base) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
571 level--;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
572 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
573 prof_exit(NULL, ticks);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
574 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
575 return;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
576 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
577
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
578 sp = bp; pc = pointer(sp[PC]); bp = valptr(sp[BP]); cp = valptr(bp[CP]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
579 do_find_proc;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
580 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
581 prof_exit(cp, ticks);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
582 ticks = 0;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
583 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
584 cond_break();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
585 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
586
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
587 inst LNUM 2 S0 {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
588 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
589 if (lflag) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
590 static module m = NULL; /* Cache most recent module */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
591 ticks--;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
592 if (m == NULL || cp < (value *) m->m_addr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
593 || cp >= (value *) (m->m_addr + m->m_length)) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
594 m = find_module(cp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
595 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
596 m->m_lcount[$a-1]++;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
597 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
598 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
599 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
600 if (intflag)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
601 debug_break(cp, bp, pc0, "interrupt");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
602 else if (one_shot)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
603 debug_break(cp, bp, pc0, "line");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
604 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
605 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
606
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
607 inst BREAK 2 S0 {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
608 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
609 debug_break(cp, bp, pc0, "break");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
610 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
611 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
612
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
613 if {[info exists SPECIALS]} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
614
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
615 # SPECIALS FOR COMPILERS COURSE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
616
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
617 defs {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
618 #define casejump(x, n0) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
619 { \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
620 int n = n0; \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
621 pc0 = pc; pc += 4*n; \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
622 while (n > 0) { \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
623 if (x == get2(pc0)) { \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
624 jump(get2(pc0+2)); \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
625 break; \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
626 } \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
627 pc0 += 4; n--; \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
628 } \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
629 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
630 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
631
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
632 inst CASEJUMP 1 S1 {casejump($1.i, $a);}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
633 zinst CASEARM 2R
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
634
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
635 inst PACK 0 B.i {pack(valptr($2), pointer($1))}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
636 inst UNPACK 0 S0 {sp--; sp[0].a = address(getcode(sp[1].i));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
637 sp[1].a = address(getenvt(sp[1].i));}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
638 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
639
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
640 zinst REG 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
641 zinst ADDR 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
642 zinst STACKW 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
643 zinst STACKQ 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
644 zinst CON 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
645
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
646
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
647 # DIRECTIVES
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
648
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
649 dir CONST ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
650 dir FCONST ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
651 dir DCONST ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
652 dir QCONST ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
653 dir GLOBAL ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
654 dir LABEL ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
655 dir PROC ????
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
656 dir END 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
657 dir PRIMDEF ???
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
658 dir DEFINE ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
659 dir STRING ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
660 dir GLOVAR ??
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
661 dir WORD ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
662 dir MODULE ???
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
663 dir ENDHDR 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
664 dir IMPORT ??
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
665 dir STKMAP ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
666 dir LINE ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
667
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
668 if {[info exists SPECIALS]} {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
669 dir PCALL ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
670 dir PCALLW ?
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
671 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
672
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
673
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
674 # EXPANSIONS USED BY THE JIT TRANSLATOR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
675
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
676 expand LDLW 1 {LOCAL $a, LOADW}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
677 expand LDLS 1 {LOCAL $a, LOADS}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
678 expand LDLC 1 {LOCAL $a, LOADC}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
679 expand LDLF 1 {LOCAL $a, LOADF}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
680 expand LDLD 1 {LOCAL $a, LOADD}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
681 expand STLW 1 {LOCAL $a, STOREW}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
682 expand STLS 1 {LOCAL $a, STORES}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
683 expand STLC 1 {LOCAL $a, STOREC}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
684 expand STLF 1 {LOCAL $a, STOREF}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
685 expand STLD 1 {LOCAL $a, STORED}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
686
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
687 expand LDGW 1 {LDKW $a, LOADW}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
688 expand LDGS 1 {LDKW $a, LOADS}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
689 expand LDGC 1 {LDKW $a, LOADC}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
690 expand LDGF 1 {LDKW $a, LOADF}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
691 expand LDGD 1 {LDKW $a, LOADD}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
692 expand STGW 1 {LDKW $a, STOREW}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
693 expand STGS 1 {LDKW $a, STORES}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
694 expand STGC 1 {LDKW $a, STOREC}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
695 expand STGF 1 {LDKW $a, STOREF}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
696 expand STGD 1 {LDKW $a, STORED}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
697
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
698 expand LDNW 1 {PUSH $a, OFFSET, LOADW}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
699 expand STNW 1 {PUSH $a, OFFSET, STOREW}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
700
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
701 expand INC 0 {PUSH 1, PLUS}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
702 expand DEC 0 {PUSH 1, MINUS}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
703
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
704 expand INCL 1 {LDLW $a, INC, STLW $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
705 expand DECL 1 {LDLW $a, DEC, STLW $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
706
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
707 expand JEQZ S {PUSH 0, JEQ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
708 expand JLTZ S {PUSH 0, JLT $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
709 expand JGTZ S {PUSH 0, JGT $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
710 expand JLEQZ S {PUSH 0, JLEQ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
711 expand JGEQZ S {PUSH 0, JGEQ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
712 expand JNEQZ S {PUSH 0, JNEQ $a}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
713
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
714 expand LDIQ 0 {INDEXD, LOADQ}
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
715 expand STIQ 0 {INDEXD, STOREQ}