Utilities contents
Saying Phrases.
10[ SayPhraseName closure;
11 if (closure == 0) print "nothing";
12 else print (string) closure-->2;
13];
18[ KindAtomic kind;
19 if ((kind >= 0) && (kind < BASE_KIND_HWM)) return kind;
20 return kind-->0;
21];
22
23[ KindBaseArity kind;
24 if ((kind >= 0) && (kind < BASE_KIND_HWM)) return 0;
25 return kind-->1;
26];
27
28[ KindBaseTerm kind n;
29 if ((kind >= 0) && (kind < BASE_KIND_HWM)) return UNKNOWN_TY;
30 return kind-->(2+n);
31];
DigitToValue.
This takes a ZSCII or Unicode character code and returns its value as a digit, or returns -1 if it isn't a digit.
38[ DigitToValue c n;
39 n = c-'0';
40 if ((n<0) || (n>9)) return -1;
41 return n;
42];
GenerateRandomNumber.
The following uses the virtual machine's RNG (via the I6 built-in function random) to produce a uniformly random integer in the range n to m inclusive, where n and m are allowed to be either way around; so that a random number between 17 and 4 is the same thing as a random number between 4 and 17, and there is therefore no pair of n and m corresponding to an empty range of values.
53[ GenerateRandomNumber n m s;
54 if (n==m) return n;
55 if (n>m) { s = n; n = m; m = s; }
56 n--;
57 return random(m-n) + n;
58];
59Constant R_DecimalNumber = GenerateRandomNumber;
60Constant R_PrintTimeOfDay = GenerateRandomNumber;
GroupChildren.
The following runs through the child-objects of par in the I6 object tree, and moves those having a given list_property property value together, to become the eldest children. It preserves the ordering in between those objects, and also in between those not having that property value.
We do this by temporarily moving objects into and out of in_obj and out_obj, objects which in all other circumstances never have children in the tree.
72[ GroupChildren par value;
73 while (child(par) ~= 0) {
74 if (LT_Compare(child(par).list_together, value) ~= 0)
75 move child(par) to out_obj;
76 else
77 move child(par) to in_obj;
78 }
79 while (child(in_obj) ~= 0) move child(in_obj) to par;
80 while (child(out_obj) ~= 0) move child(out_obj) to par;
81 return child(par);
82];
PrintSpaces.
Which prints a row of n spaces, for n ≥ 0.
88[ PrintSpaces n;
89 while (n > 0) {
90 print " ";
91 n = n - 1;
92 }
93];
RunRoutines.
This function may not be very well-named, but the idea is to take a property of a given object and either to print it (and return true) if it's a string, and call it (and pass along its return value) if it's a routine. If the object does not provide the property, we act on the default value for the property if it has one, and otherwise do nothing (and return false).
The I6 pseudo-object thedark is used to give the impression that Darkness is a room in its own right, which is not really true. Note that it is not permitted to have properties other than the three named here: all other properties are redirected to the current location's object.
Properties with numbers under INDIV_PROP_START are "common properties". These come along with a table of default values, so that it is meaningful (in I6, anyway) to read them even when they are not provided (so that the address, returned by the .& operator, is zero).
113[ RunRoutines obj prop;
114 if (obj == thedark) obj = real_location;
115 if ((obj.&prop == 0) && (prop >= INDIV_PROP_START)) rfalse;
116 return obj.prop();
117];
SwapWorkflags.
Recall that we have two general-purpose temporary attributes for each object: workflag and workflag2. The following swaps their values over for every object at once.
125[ SwapWorkflags obj lst;
126 objectloop (obj ofclass Object) {
127 lst = false;
128 if (obj has workflag2) lst = true;
129 give obj ~workflag2;
130 if (obj has workflag) give obj workflag2;
131 give obj ~workflag;
132 if (lst) give obj workflag;
133 }
134];
TestUseOption.
This routine, compiled by NI, returns true if the supplied argument is the number of a use option in force for the current run of NI, and false otherwise.
142{-routine:UseOptions::TestUseOption}
IntegerDivide.
We can't simply use I6's / operator, as that translates directly into a virtual machine opcode which crashes on divide by zero.
149[ IntegerDivide A B;
150 if (B == 0) { RunTimeProblem(RTP_DIVZERO); rfalse; }
151 return A/B;
152];
IntegerRemainder.
Similarly.
158[ IntegerRemainder A B;
159 if (B == 0) { RunTimeProblem(RTP_DIVZERO); rfalse; }
160 return A%B;
161];
UnsignedCompare.
Comparison of I6 integers is normally signed, that is, treating the word as a twos-complement signed number, so that $FFFF is less than 0, for instance. If we want to construe words as being unsigned integers, or as addresses, we need to compare them with the following routine, which returns 1 if x>y, 0 if x=y and -1 if x<y.
171[ UnsignedCompare x y u v;
172 #Ifdef TARGET_GLULX;
173 @jleu x y ?lesseq;
174 return 1;
175 .lesseq;
176 @jeq x y ?equal;
177 return -1;
178 .equal;
179 return 0;
180 #Ifnot;
181 if (x == y) return 0;
182 if (x < 0 && y >= 0) return 1;
183 if (x >= 0 && y < 0) return -1;
184 u = x&~WORD_HIGHBIT; v= y&~WORD_HIGHBIT;
185 if (u > v) return 1;
186 return -1;
187 #Endif;
188];
189
SignedCompare.
This routine is hardly ever needed; it wraps up ordinary comparisons.
195[ SignedCompare x y;
196 if (x > y) return 1;
197 if (x == y) return 0;
198 return -1;
199];
ZRegion.
I7 contains many relics from I6, but here's a relic from I5: a routine which used to determine the metaclass of a value, before that concept was given a name. In I6 code, it can be implemented simply using metaclass, as the following shows. (The name is from "region of the Z-machine".)
208[ ZRegion addr;
209 switch (metaclass(addr)) {
210 nothing: return 0;
211 Object, Class: return 1;
212 Routine: return 2;
213 String: return 3;
214 }
215];
Memcpy.
This is equivalent to C's memcpy function, in good ways and bad.
221[ Memcpy to_addr from_addr size n;
222#Ifdef TARGET_ZCODE;
223 for (n = size/WORDSIZE: (n--) > 0: ) to_addr-->n = from_addr-->n;
224 for (n = size: ((n--) % WORDSIZE ~= 0): ) to_addr->n = from_addr->n;
225#Ifnot;
226 @mcopy size from_addr to_addr;
227#Endif;
228];
Arrcpy.
This is not quite so efficient, but not terrible.
234[ Arrcpy to_array to_entry_size from_array from_entry_size no_entries n val;
235 if (to_entry_size == from_entry_size)
236 Memcpy(to_array, from_array, to_entry_size*no_entries);
237 else if ((to_entry_size == 2) && (from_entry_size == 4)) {
238 for (n = 0: n<no_entries: n++) {
239 val = from_array-->n;
240 to_array->0 = (val/256)%256; to_array->1 = val%256;
241 to_array = to_array + 2;
242 }
243 } else "*** Arrcpy doesnt support this ***";
244];