/[dtapublic]/projs/ets/trunk/src/c_tclxtens_7_5/crchashextns.c
ViewVC logotype

Annotation of /projs/ets/trunk/src/c_tclxtens_7_5/crchashextns.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 98 - (hide annotations) (download)
Sun Dec 18 00:57:31 2016 UTC (7 years, 6 months ago) by dashley
Original Path: projs/dtats/trunk/shared_source/c_tclxtens_7_5/crchashextns.c
File MIME type: text/plain
File size: 13336 byte(s)
Reorganization.
1 dashley 71 //$Header$
2     //-------------------------------------------------------------------------------------------------
3     //This file is part of "David T. Ashley's Shared Source Code", a set of shared components
4     //integrated into many of David T. Ashley's projects.
5     //-------------------------------------------------------------------------------------------------
6     //This source code and any program in which it is compiled/used is provided under the MIT License,
7     //reproduced below.
8     //-------------------------------------------------------------------------------------------------
9     //Permission is hereby granted, free of charge, to any person obtaining a copy of
10     //this software and associated documentation files(the "Software"), to deal in the
11     //Software without restriction, including without limitation the rights to use,
12     //copy, modify, merge, publish, distribute, sublicense, and / or sell copies of the
13     //Software, and to permit persons to whom the Software is furnished to do so,
14     //subject to the following conditions :
15     //
16     //The above copyright notice and this permission notice shall be included in all
17     //copies or substantial portions of the Software.
18     //
19     //THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
20     //IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
21     //FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.IN NO EVENT SHALL THE
22     //AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
23     //LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24     //OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
25     //SOFTWARE.
26     //-------------------------------------------------------------------------------------------------
27     #define MODULE_CRCHASHEXTNS
28    
29     #include <string.h>
30    
31     #include "tcl.h"
32     #include "tcldecls.h"
33    
34     #include "crchashextns.h"
35     #include "crchashfuncs.h"
36    
37     #include "strfuncs.h"
38     #include "tclalloc.h"
39    
40    
41     //Procedure called when the "crc32" command is encountered in a Tcl script.
42     //
43     int CRCHASHEXTNS_Crc32extnCommand(ClientData dummy,
44     Tcl_Interp *interp,
45     int objc,
46     Tcl_Obj *objv[])
47     {
48     Tcl_Obj *rv;
49     //Value that will be returned.
50     Tcl_Obj *block_obj;
51     //Used for file reads.
52     char buffer[11];
53     //Space for "0x" followed by 8 hex chars and terminator.
54     struct CRCHASHFUNCS_Crc32StateStruct crc_state;
55     //CRC state structure, internals nominally known and accessible to another
56     //another software module.
57     unsigned long crc;
58     //Calculated CRC.
59     unsigned long bytearraysize;
60     //Size of block allocated or portion used.
61     char *bytearrayptr;
62     //Pointer to array of bytes.
63     char *fname;
64     //File name specified.
65     char *blockbuf;
66     //Pointer to array of bytes.
67     Tcl_Channel chan;
68     //Channel opened using the Tcl libraries.
69     int return_code, return_code_b;
70     //Return codes from Tcl library functions.
71     int loop_exit_flag;
72     //Looping exit flag.
73     int chars_read;
74     //Number of characters read (i.e. for short read).
75     int block_obj_n;
76    
77    
78     if (objc < 2 || objc > 3)
79     {
80     Tcl_WrongNumArgs(interp,
81     1,
82     objv,
83     "?-string? filename_or_string_value");
84    
85     return TCL_ERROR;
86     }
87     else if (objc == 2)
88     {
89     //Be sure that the internal crc table has been built. This function
90     //also returns a table correctness code. Error out severely if the
91     //CRC module believes its internal data has been corrupted.
92     if (!CRCHASHFUNCS_Crc32TableCheck())
93     {
94     //Serious internal error. Error out.
95    
96     //Create the return object.
97     rv = Tcl_NewStringObj("CRCHASHEXTNS.C: Serious internal error: CRC-32 lookup table corrupted.", -1);
98    
99     //Set the return value to be the error message.
100     Tcl_SetObjResult(interp, rv);
101    
102     //Error return.
103     return TCL_ERROR;
104     }
105    
106     //We need to open a channel, run it through the CRC algorithm, and
107     //return results.
108    
109     //Get the string representation of the object.
110     fname = Tcl_GetString(objv[1]);
111    
112     //Attempt to open a file channel. The error information, if any,
113     //will be placed in the interpreter's state.
114     chan = Tcl_OpenFileChannel(interp, fname, "r", 0);
115    
116     //There is the possibility that the channel could not be opened
117     //successfully. If there was an error, error out.
118     if (!chan)
119     {
120     //Create the return object.
121     rv = Tcl_NewStringObj("crc32: Tcl_OpenFileChannel() failure on file name: ", -1);
122    
123     //Tack on the offensive argument.
124     Tcl_AppendToObj(rv, fname, -1);
125    
126     //Set the return value to be the error message.
127     Tcl_SetObjResult(interp, rv);
128    
129     //Error return.
130     return TCL_ERROR;
131     }
132    
133     //Try to set the channel encoding to binary and record the return code.
134     return_code = Tcl_SetChannelOption(interp, chan, "-encoding", "binary");
135    
136     //Try to set the channel translation mode to binary and record the return
137     //code.
138     if (return_code == TCL_OK)
139     return_code_b = Tcl_SetChannelOption(interp, chan, "-translation", "binary");
140    
141     //If the attempt to set the channel encoding or translation
142     //didn't go well, error out. Must also try to chose the channel because
143     //it was successfully opened.
144     if ((return_code != TCL_OK) || (return_code_b != TCL_OK))
145     {
146     //Try to close the channel. "interp" not supplied so as not
147     //to overwrite error info.
148     Tcl_Close(NULL, chan);
149    
150     //Create the return object.
151     rv = Tcl_NewStringObj("crc32: Tcl_SetChannelOption() failure.", -1);
152    
153     //Set the return value to be the error message.
154     Tcl_SetObjResult(interp, rv);
155    
156     //Error return.
157     return TCL_ERROR;
158     }
159    
160     //Allocate the object to hold the block buffer. I've examined the
161     //function, and cannot do it with with a NULL pointer. Must instead
162     //allocate SOMETHING, although it will be destroyed immediately on
163     //the first read. This will have reference count zero.
164     block_obj = Tcl_NewByteArrayObj("Trash", 5);
165    
166     //Calculate the CRC. The essential process is to keep reading
167     //and adding to the CRC until end of file.
168     //Open and initialize the necessary structure.
169     CRCHASHFUNCS_Crc32StateStructOpen(&crc_state);
170    
171     loop_exit_flag = 0;
172    
173     do
174     {
175     //Grab as many chars as possible, up to 65536 of them.
176     //65536 was chosen because this is large enough for great
177     //performance, but small enough that it won't make a significant
178     //virtual memory impact.
179     chars_read = Tcl_ReadChars(chan, block_obj, 65536, 0);
180    
181     //If the characters read shows as <0, this is an error
182     //condition. Trap.
183     if (chars_read < 0)
184     {
185     //Try to close the channel. "interp" not supplied so as not
186     //to overwrite error info.
187     Tcl_Close(NULL, chan);
188    
189     //Deallocate the buffer used to accept block file reads. Because the
190     //creation process set the reference count to zero, a single
191     //decrement will destroy the object.
192     Tcl_DecrRefCount(block_obj);
193    
194     //Create the return object.
195     rv = Tcl_NewStringObj("crc32: Tcl_ReadChars() failure.", -1);
196    
197     //Set the return value to be the error message.
198     Tcl_SetObjResult(interp, rv);
199    
200     //Error return.
201     return TCL_ERROR;
202     }
203    
204     //Obtain a pointer to the binary block that was read.
205     blockbuf = Tcl_GetByteArrayFromObj(block_obj, &block_obj_n);
206    
207     //Add to the CRC for those chars read. Skip the zero case.
208     if (block_obj_n > 0)
209     {
210     CRCHASHFUNCS_Crc32StateStructAddData(&crc_state,
211     blockbuf,
212     block_obj_n);
213     }
214    
215     //We want to exit if EOF is true. A short read would
216     //also be an indication, but short read should imply
217     //EOF, so should not test both.
218     return_code = Tcl_Eof(chan);
219     loop_exit_flag = (return_code != 0);
220     } while(!loop_exit_flag);
221    
222     //Extract the CRC.
223     crc = CRCHASHFUNCS_Crc32Extract(&crc_state);
224    
225     //Postprocess the structure.
226     CRCHASHFUNCS_Crc32StateStructClose(&crc_state);
227    
228     //Close the channel.
229     return_code = Tcl_Close(interp, chan);
230    
231     //If there was an error closing the channel, error out.
232     if (return_code != TCL_OK)
233     {
234     //Create the return object.
235     rv = Tcl_NewStringObj("crc32: Tcl_Close() failure.", -1);
236    
237     //Set the return value to be the error message.
238     Tcl_SetObjResult(interp, rv);
239    
240     //Error return.
241     return TCL_ERROR;
242     }
243    
244     //Deallocate the buffer used to accept block file reads. Because the
245     //creation process set the reference count to zero, a single
246     //decrement will destroy the object.
247     Tcl_DecrRefCount(block_obj);
248    
249     //Return the CRC to the caller. No detectable errors
250     //are possible at this point.
251    
252     //Convert the long integer to a hexadecimal representation.
253     Strfuncs_UlToHexString(crc, buffer+2, 1);
254    
255     //Stuff the leading characters of the hexadecimal representation.
256     buffer[0] = '0';
257     buffer[1] = 'x';
258    
259     //Stuff the string terminator.
260     buffer[10] = 0;
261    
262     //Create the return object.
263     rv = Tcl_NewStringObj(buffer, -1);
264    
265     //Set the return value to be the hexadecimal representation of the
266     //CRC.
267     Tcl_SetObjResult(interp, rv);
268    
269     //Everything went well, return the OK code.
270     return TCL_OK;
271     }
272     else /* if (objc == 3) */
273     {
274     //The second parameter positively must be "-string" or a substring
275     //of that. At present, there are no competing option flags, so
276     //a simple substring lookup will handle it.
277     //Yank the string pointer.
278     bytearrayptr = Tcl_GetString(objv[1]);
279    
280     //If not a substring, error out.
281     if ((strlen(bytearrayptr)<2) || !Strfuncs_IsSubstring(bytearrayptr, "-string"))
282     {
283     //Create the return object.
284     rv = Tcl_NewStringObj("crc32: Unrecognized switch: ", -1);
285    
286     //Tack on the offensive argument.
287     Tcl_AppendToObj(rv, bytearrayptr, -1);
288    
289     //Set the return value to be the error message.
290     Tcl_SetObjResult(interp, rv);
291    
292     //Error return.
293     return TCL_ERROR;
294     }
295    
296     //Convert the last parameter to its byte representation and get a
297     //pointer to this representation and the length. This was the
298     //library call that Ajuba recommended.
299     bytearrayptr = Tcl_GetByteArrayFromObj(objv[2], &bytearraysize);
300    
301     //Be sure that the internal crc table has been built. This function
302     //also returns a table correctness code. Error out severely if the
303     //CRC module believes its internal data has been corrupted.
304     if (!CRCHASHFUNCS_Crc32TableCheck())
305     {
306     //Serious internal error. Error out.
307    
308     //Create the return object.
309     rv = Tcl_NewStringObj("CRCHASHEXTNS.C: Serious internal error: CRC-32 lookup table corrupted.", -1);
310    
311     //Set the return value to be the error message.
312     Tcl_SetObjResult(interp, rv);
313    
314     //Error return.
315     return TCL_ERROR;
316     }
317    
318     //Open and initialize the necessary structure.
319     CRCHASHFUNCS_Crc32StateStructOpen(&crc_state);
320    
321     //Process the string.
322     CRCHASHFUNCS_Crc32StateStructAddData(&crc_state,
323     bytearrayptr,
324     bytearraysize);
325     //Extract the CRC.
326     crc = CRCHASHFUNCS_Crc32Extract(&crc_state);
327    
328     //Postprocess the structure.
329     CRCHASHFUNCS_Crc32StateStructClose(&crc_state);
330    
331     //Convert the long integer to a hexadecimal representation.
332     Strfuncs_UlToHexString(crc, buffer+2, 1);
333    
334     //Stuff the leading characters of the hexadecimal representation.
335     buffer[0] = '0';
336     buffer[1] = 'x';
337    
338     //Stuff the string terminator.
339     buffer[10] = 0;
340    
341     //Create the return object.
342     rv = Tcl_NewStringObj(buffer, -1);
343    
344     //Set the return value to be the hexadecimal representation of the
345     //CRC.
346     Tcl_SetObjResult(interp, rv);
347    
348     //Everything went well, return the OK code.
349     return TCL_OK;
350     }
351     }
352    
353    
354     //Performs initial registration to the hash table.
355     //
356     void CRCHASHEXTNS_Crc32extnInit(Tcl_Interp *interp)
357     {
358     //Register a command named "crc32".
359     Tcl_CreateObjCommand(interp,
360     "crc32",
361     (Tcl_ObjCmdProc *)CRCHASHEXTNS_Crc32extnCommand,
362     NULL,
363     NULL);
364     }
365    
366    
367     //Returns version control string for file.
368     //
369     const char *CRCHASHEXTNS_cvcinfo(void)
370     {
371     return ("$Header$");
372     }
373    
374    
375     //Returns version control string for associated .H file.
376     //
377     const char *CRCHASHEXTNS_hvcinfo(void)
378     {
379     return (CRCHASHEXTNS_H_VERSION);
380     }
381    
382     //End of crchashextns.c.

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25