1 /*
2 * $Id: idlsave.i,v 1.1 2005-09-18 22:06:15 dhmunro Exp $
3 * read IDL save files
4 * IDL is a trademark of Reasearch Systems Incorporated (RSI)
5 * code based on work of Craig Markwardt
6 * http://cow.physics.wisc.edu/~craigm/idl/
7 */
8 /*
9 ; ============== STATEMENT OF RESEARCH SYSTEMS INCORPORATED ==============
10 ;---------------------------------------------------------------------------
11 ; IDL is a product of Research Systems, Inc (RSI). Use of IDL is governed
12 ; by the IDL End User License Agreement (EULA). All IDL users are
13 ; required to read and agree to the terms of the IDL EULA at the time
14 ; that they install IDL.
15 ;
16 ; The CMSVLIB software, written by Craig Markwardt, embodies
17 ; unpublished proprietary information about the IDL Save file
18 ; format. Research Systems grants to the author of this software, and
19 ; to all IDL users, a license to use and redistribute this software in
20 ; source or binary form, subject to the following conditions:
21 ;
22 ; 1. The author, and any users of this software must be in full
23 ; compliance with the IDL End User License Agreement (EULA).
24 ; 2. Redistributions of source code must retain the complete and
25 ; unaltered text of this notice.
26 ; 3. Redistributions in binary form must reproduce the complete and
27 ; unaltered text of this notice in the documentation and/or other
28 ; materials provided with the distribution.
29 ; 4. The name of Research Systems Inc. may not be used to endorse or
30 ; promote this software or products derived from it without specific
31 ; prior written permission from Research Systems, Inc.
32 ; 5. Allowed use of this software is limited to reading and writing
33 ; IDL variable related portions of IDL Save files. It may not be
34 ; used as a basis for reverse engineering, or otherwise
35 ; accessing any other portions of an IDL save file, including but
36 ; not limited to, those portions that encode executable IDL programs.
37 ; Such use is in violation of the IDL EULA, and will be prosecuted
38 ; to the fullest extent possible by Research Systems, Inc. It is
39 ; permissible to read such sections of an IDL save file for the
40 ; sole purpose of transferring it without examination or interpretation
41 ; to another save file.
42 ; 6. Research Systems disclaims any responsibility for compatibility
43 ; with this software, and reserves the right to change the IDL save
44 ; file format in any way, at any time, including changes that would
45 ; render this software incomplete or inoperable.
46 ; 7. This software is not a product of Research Systems Inc. Research
47 ; Systems Inc disclaims any responsibility for its development or
48 ; maintenance.
49 ;
50 ; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
51 ; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
52 ; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
53 ; IN NO EVENT SHALL THE AUTHOR OR RESEARCH SYSTEMS INC BE LIABLE FOR ANY
54 ; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
55 ; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
56 ; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
57 ; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
58 ; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
59 ; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
60 ; SUCH DAMAGE.
61 ;---------------------------------------------------------------------------
62 */
63
64 func idl_open(name, &commons, loud=)
65 /* DOCUMENT f = idl_open(filename)
66 * or f = idl_open(filename, commons)
67 * openb for an IDL save file
68 * optional COMMONS is returned as an array of pointers to
69 * arrays of strings; the first string in each array is the name
70 * of an IDL common block; the others are the names of the
71 * variables in that common block
72 * all variable names have been converted to lower case
73 * loud=1 keyword reports on timestamp and other information
74 * about the user, host, etc., stored in the save file
75 *
76 * floating complex data becomes an array of float with leading
77 * dimension of 2, use f2z to recover complex
78 * 64 bit integers become an array of long with leading dimension
79 * of 2, use l2ll to recover single long (if sizeof(long)=8)
80 *
81 * SEE ALSO: openb, f2z, l2ll
82 */
83 {
84 f = open(name, "rb");
85 sign = array(char, 4);
86 _read, f, 0, sign;
87 if (anyof(sign != ['S','R','\0','\4']))
88 error, name+" signature not that of IDL save file";
89 /* Markwardt doesn't say that save file is XDR format, but seems to be */
90 xdr_primitives, f; /* ?? save files always big-endian, 4 byte longs ?? */
91 len = sizeof(f);
92
93 commons = [];
94 ncommon = 0;
95 a64 = 0;
96 for (addr=4 ; addr<len ;) {
97 addr0 = addr;
98 type = _idl_record(f, a64, addr);
99 if (type == 6) break;
100 addr0 += 16+a64;
101 if (type == 10) {
102 addr0 += 1024;
103 date = _idl_string(f, addr0);
104 user = _idl_string(f, addr0);
105 host = _idl_string(f, addr0);
106 if (loud) {
107 write, format="Date: %s\n", date;
108 write, format="User: %s\n", user;
109 write, format="Host: %s\n", host;
110 }
111 } else if (type == 14) {
112 sfmt = 0;
113 _read, f, addr0, sfmt;
114 addr0 += 4;
115 arch = _idl_string(f, addr0);
116 osys = _idl_string(f, addr0);
117 ridl = _idl_string(f, addr0);
118 if (loud) {
119 write, format="Save: %ld\n", sfmt;
120 write, format="Arch: %s\n", arch;
121 write, format="OS: %s\n", osys;
122 write, format="IDL: %s\n", ridl;
123 }
124 } else if (type == 13) {
125 author = _idl_string(f, addr0);
126 title = _idl_string(f, addr0);
127 other = _idl_string(f, addr0);
128 if (loud) {
129 write, format="Author: %s\n", author;
130 write, format="Title: %s\n", title;
131 write, format="Other: %s\n", other;
132 }
133 } else if (type == 15) {
134 write, "WARNING: "+name+" has IDL pointers";
135 } else if (type == 17) {
136 if (loud) write, "64 bit addresses present";
137 } else if (type == 1) {
138 nvars = 0;
139 _read, f, addr0, nvars;
140 addr0 += 4;
141 if (ncommon >= numberof(commons))
142 grow, commons, array(pointer, max(numberof(commons), 4));
143 com = array(string, nvars+1);
144 for (i=1 ; i<=nvars+1 ; i++) com(i) = _idl_string(f, addr0, 1);
145 commons(++ncommon) = &com;
146 com = [];
147 } else if (type==2 || type==3) {
148 vname = _idl_string(f, addr0, 1);
149 if (_idl_type(f, addr0, vtype, vdims))
150 add_variable, f, addr0, vname, vtype, vdims;
151 }
152 }
153 if (ncommon && loud) write, format="Common blocks: %ld\n", ncommon;
154 return f;
155 }
156
157 /* record types:
158 * 0 start_marker -- start of save file
159 * 1 common -- common block
160 * 2 variable
161 * 3 system_variable
162 * 6 end_marker -- end of save file (no more records)
163 * 10 timestamp
164 * 12 compiled -- IDL byte code
165 * 13 identification -- of author
166 * 14 version -- of IDL
167 * 15 heap_header -- index info for heap
168 * 16 heap_data -- heaps used for pointer data
169 * 17 promote64 -- begin 64 bit record addresses
170 */
171
172 func _idl_record(f, &a64, &addr)
173 {
174 head = array(long, 3);
175 _read, f, addr, head;
176 type = head(1);
177 addr = head(2);
178 addrlo = head(3);
179 /* Markwardt doesn't say if promote64 record itself has 8 byte addr! */
180 if (!addr && addrlo) addr = addrlo;
181 else if (a64) addr = addrlo | (addr<<32);
182 if (type == 17) a64 = 4;
183 return type;
184 }
185
186 func _idl_string(f, &addr, lc)
187 {
188 len = 0;
189 _read, f, addr, len;
190 addr += 4;
191 if (len > 0) {
192 c = array(char, len);
193 _read, f, addr, c;
194 addr += len;
195 len &= 3;
196 if (len) addr += 4-len;
197 if (lc) {
198 list = where((c>='A') & (c<='Z'));
199 if (numberof(list)) c(list) |= ('A'~'a');
200 }
201 } else if (len < 0) {
202 c = [];
203 }
204 return string(&c);
205 }
206
207 /* data types (Sun XDR format):
208 * 1 char
209 * 2 short
210 * 3 long
211 * 4 float
212 * 5 double
213 * 6 fcomplex
214 * 7 (string)
215 * 8 (struct)
216 * 9 complex
217 * 10 (pointer)
218 * 11 (object reference)
219 * 12 ushort
220 * 13 ulong
221 * 14 llong (64 bit)
222 * 15 ullong (64 bit)
223 */
224
225 func _idl_type(f, &addr, &vtype, &vdims)
226 {
227 vtype = 0;
228 _read, f, addr, vtype;
229 addr += 4;
230 flag = 0;
231 _read, f, addr, flag;
232 addr += 4;
233 vdims = [];
234 /* flag bit 0x10 may indicate membership in a common block */
235 if (flag & 0x24) {
236 ad = array(0, 4);
237 _read, f, addr, ad;
238 /* ad(2) = 0x02 normally, 0x04, 0x08 observed in common block vars
239 * 0x36 in system vars with broken dimension lists (IDL 6.0)
240 */
241 if (ad(1)!=8 || (ad(2)&0x20)) {
242 if (loud) write, "WARNING: unknown type, skipping "+vname;
243 return 0;
244 }
245 ndims = 0;
246 addr += 16;
247 _read, f, addr, ndims;
248 addr += 12;
249 if (ndims<1 || ndims>10) {
250 if (loud) write, "WARNING: bad dims, skipping "+vname;
251 return 0;
252 }
253 vdims = array(0, 1+ndims);
254 _read, f, addr, vdims;
255 addr += 4*(vdims(1)+1);
256 vdims(1) = ndims;
257 if (flag & 0x20) {
258 /* don't bother with structs for now */
259 if (loud) write, "WARNING: struct type, skipping "+vname;
260 return 0;
261 }
262 }
263 addr += 4;
264 if (vtype == 1) {
265 vtype = char;
266 return 1;
267 } else if (vtype==2 || vtype==12) {
268 vtype = short;
269 return 1;
270 } else if (vtype==3 || vtype==13) {
271 vtype = long;
272 return 1;
273 } else if (vtype == 4) {
274 vtype = float;
275 return 1;
276 } else if (vtype == 5) {
277 vtype = double;
278 return 1;
279 } else if (vtype == 9) {
280 vtype = complex;
281 return 1;
282 } else if (vtype == 6) {
283 /* see f2z below */
284 vtype = float;
285 if (!numberof(vdims)) {
286 vdims = [1,2];
287 } else {
288 vdims = grow([vdims(1)+1],vdims);
289 vdims(2) = 2;
290 }
291 return 1;
292 } else if (vtype==14 || vtype==15) {
293 /* see l2ll below */
294 vtype = long;
295 if (!numberof(vdims)) {
296 vdims = [1,2];
297 } else {
298 vdims = grow([vdims(1)+1],vdims);
299 vdims(2) = 2;
300 }
301 return 1;
302 }
303 return 0;
304 }
305
f2z(x)306 func f2z(x)
307 /* DOCUMENT z = f2z(x)
308 * convert 2-by-dims float or double X to complex.
309 */
310 {
311 z = x(1,..)+0.0i;
312 z.im = x(2,..);
313 return z;
314 }
315
l2ll(x)316 func l2ll(x)
317 /* DOCUMENT z = l2ll(x)
318 * convert 2-by-dims 32 bit integer X to 64 bit integer
319 * (only works if sizeof(long)=8)
320 */
321 {
322 return long(x(2,..)) | (long(x(1,..))<<32);
323 }
324