1 /*
2 * Copyright © 1988-2004 Keith Packard and Bart Massey.
3 * All Rights Reserved. See the file COPYING in this directory
4 * for licensing information.
5 */
6
7 #include "nickle.h"
8
9 static Value
RefPlus(Value av,Value bv,int expandOk)10 RefPlus (Value av, Value bv, int expandOk)
11 {
12 ENTER();
13 int i;
14 Ref *ref;
15
16 if (ValueIsInt(av))
17 {
18 i = IntPart (av, "Attempt to add non-integer to reference type");
19 if (aborting)
20 RETURN (Void);
21 ref = &bv->ref;
22 }
23 else if (ValueIsInt(bv))
24 {
25 i = IntPart (bv, "Attempt to add non-integer to reference type");
26 if (aborting)
27 RETURN (Void);
28 ref = &av->ref;
29 }
30 else
31 RETURN (Void);
32 i = i + ref->element;
33 if (i < 0 || i >= ref->box->nvalues ||
34 (!ref->box->homogeneous && i != ref->element))
35 {
36 RaiseStandardException (exception_invalid_array_bounds, 2,
37 av, bv);
38 RETURN (Void);
39 }
40 RETURN (NewRef (ref->box, i));
41 }
42
43 static Value
RefMinus(Value av,Value bv,int expandOk)44 RefMinus (Value av, Value bv, int expandOk)
45 {
46 ENTER();
47 int i;
48 int element;
49 Ref *ref, *bref;
50
51 if (ValueIsInt(av))
52 {
53 i = IntPart (av, "Attempt to subtract non-integer to reference type");
54 if (aborting)
55 RETURN (Void);
56 ref = &bv->ref;
57 element = -ref->element;
58 }
59 else if (ValueIsInt(bv))
60 {
61 i = -IntPart (bv, "Attempt to subtract non-integer to reference type");
62 if (aborting)
63 RETURN (Void);
64 ref = &av->ref;
65 element = ref->element;
66 }
67 else
68 {
69 ref = &av->ref;
70 bref = &bv->ref;
71 if (ref->box != bref->box)
72 {
73 RaiseStandardException (exception_invalid_binop_values, 2,
74 av, bv);
75 RETURN (Void);
76 }
77 RETURN (NewInt (ref->element - bref->element));
78 }
79 i = i + element;
80 if (i < 0 || i >= ref->box->nvalues || (!ref->box->homogeneous && i != ref->element))
81 {
82 RaiseStandardException (exception_invalid_array_bounds, 2,
83 av, bv);
84 RETURN (Void);
85 }
86 RETURN (NewRef (ref->box, i));
87 }
88
89 static Value
RefLess(Value av,Value bv,int expandOk)90 RefLess (Value av, Value bv, int expandOk)
91 {
92 Ref *aref = &av->ref, *bref = &bv->ref;
93
94 if (aref->box != bref->box ||
95 (!aref->box->homogeneous && aref->element != bref->element))
96 {
97 RaiseStandardException (exception_invalid_binop_values, 2,
98 av, bv);
99 return FalseVal;
100 }
101 if (aref->element < bref->element)
102 return TrueVal;
103 return FalseVal;
104 }
105
106 static Value
RefEqual(Value av,Value bv,int expandOk)107 RefEqual (Value av, Value bv, int expandOk)
108 {
109 Ref *aref = &av->ref, *bref = &bv->ref;
110
111 if (aref->box != bref->box || aref->element != bref->element)
112 return FalseVal;
113 return TrueVal;
114 }
115
116 static ValueRep *
RefTypeCheck(BinaryOp op,Value av,Value bv,int expandOk)117 RefTypeCheck (BinaryOp op, Value av, Value bv, int expandOk)
118 {
119 switch (op) {
120 case MinusOp:
121 if (ValueIsRef(av) && ValueIsRef(bv))
122 return av->value.type;
123 case PlusOp:
124 if (ValueIsInt(av))
125 return bv->value.type;
126 if (ValueIsInt(bv))
127 return av->value.type;
128 break;
129 case LessOp:
130 case EqualOp:
131 if (ValueIsRef(av) && ValueIsRef(bv))
132 return av->value.type;
133 break;
134 default:
135 break;
136 }
137 return 0;
138 }
139
140 static Bool
RefPrint(Value f,Value av,char format,int base,int width,int prec,int fill)141 RefPrint (Value f, Value av, char format, int base, int width, int prec, int fill)
142 {
143 FileOutput (f, '&');
144 return Print (f, RefValueGet (av), format, base, width ? width - 1 : 0, prec, fill);
145 }
146
147 static void
RefMark(void * object)148 RefMark (void *object)
149 {
150 Ref *ref = object;
151
152 if (ref->box->replace)
153 ref->box = BoxRewrite (ref->box, &ref->element);
154 MemReference (ref->box);
155 }
156
157 ValueRep RefRep = {
158 { RefMark, 0, "RefRep" }, /* data */
159 rep_ref, /* tag */
160 { /* binary */
161 RefPlus,
162 RefMinus,
163 0,
164 0,
165 0,
166 0,
167 RefLess,
168 RefEqual,
169 0,
170 0,
171 },
172 { /* unary */
173 0,
174 0,
175 0,
176 },
177 0,
178 0,
179 RefPrint,
180 RefTypeCheck,
181 };
182
183 DataCachePtr refCache;
184
185 Value
NewRefReal(BoxPtr box,int element,Value * re)186 NewRefReal (BoxPtr box, int element, Value *re)
187 {
188 ENTER ();
189 Value ret = ALLOCATE (&RefRep.data, sizeof (Ref));
190 ret->ref.box = box;
191 ret->ref.element = element;
192 *re = ret;
193 RETURN (ret);
194 }
195
196 void
RefRewrite(Value rv)197 RefRewrite (Value rv)
198 {
199 Ref *ref= &rv->ref;
200 BoxPtr box = ref->box;
201
202 if (box->replace)
203 ref->box = BoxRewrite (box, &ref->element);
204 }
205
206 int
RefInit(void)207 RefInit (void)
208 {
209 ENTER ();
210 refCache = NewDataCache(REF_CACHE_SIZE);
211 EXIT ();
212 return 1;
213 }
214