Context Navigation

source: git/MP/MP/MP_Put.c @ 224da5b

fieker-DuValspielwiese

Last change on this file since 224da5b was 7adb502, checked in by Olaf Bachmann <obachman@…>, 27 years ago
* removed conflicts from MP_1_1_2_0 conflicts git-svn-id: file:///usr/local/Singular/svn/trunk@444 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 43.9 KB

Line
1	/**************************************************************************
2	*
3	* MP version 1.1.2: Multi Protocol
4	* Kent State University, Kent, OH
5	* Authors: S. Gray, N. Kajler, P. Wang
6	* (C) 1993, 1994, 1995, 1996, 1997 All Rights Reserved
7	*
8	* NOTICE
9	*
10	* Permission to use, copy, modify, and distribute this software and
11	* its documentation for non-commercial purposes and without fee is
12	* hereby granted provided that the above copyright notice appear in all
13	* copies and that both the copyright notice and this permission notice
14	* appear in supporting documentation.
15	*
16	* Neither Kent State University nor the Authors make any representations
17	* about the suitability of this software for any purpose. The MP Library
18	* is distributed in the hope that it will be useful, but is provided "as
19	* is" and without any warranty of any kind and without even the implied
20	* warranty of merchantability or fitness for a particular purpose.
21	*
22	*
23	* IMPLEMENTATION FILE: MP_Put.c
24	*
25	* All the put routines.
26	*
27	* Change Log:
28	* May 30, 1995 SG - added MP_PutSint8Packet()
29	* June 5, 1995 SG - added MP_PutUint8Packet()
30	* - changed IMP_PutOperator() to only output
31	* the operator, as a string. That is, it no
32	* longer also sends a num_child field, since that
33	* job is now done by imp_put_node_header().
34	* IMP_PutMpOperator() is handled in MP_Put.h
35	* July 6, 1995 SG - added MP_PutLatin/GreekCommonIdentifierPacket()
36	* - added MP_PutCommonOperatorPacket()
37	* - added MP_PutCommonConstantPacket()
38	* July 7, 1995 SG - added MP_PutBooleanPacket()
39	* - changed MP_CantPut<type>Packet error values to
40	* MP_CantPut<type>
41	* - cleaned up some comments/unneeded code.
42	* 10/18/95 OB - changed PutApInt routines such that
43	* only size field is communicated, not the alloc field
44	* 12/1/95 SG - fixed bug in routines which have to pad a value with
45	* NULL bytes to get the right alignment
46	* 2/28/96 SG - Changed the NodeFlags fields to DictTag to reflect
47	* the change in how we identify dictionaries and do
48	* semantics. Also changed IMP_PutNodeHeader() so
49	* that it now takes arguments for all of the fields
50	* in a packet header. BUT - see comment with
51	* IMP_PutNodeHeader() regarding dictionary tags.
52	* 4/29/96 sgray - Made the PutApInt() routines more generic. They
53	* now take a pointer to void. So the sender can
54	* send in its "native" bignum format (provided we
55	* have the supporting routines in place). New formats
56	* can be added as needed without affecting the design.
57	* 3/11/97 sgray - Fixed logging of ApInts as recommended by obachman.
58	* Also cleaned up logging in the PutString and ApReal
59	* functions.
60	* - added Olaf's routines to put the MetaOperator and
61	* CommonMeta types.
62	**************************************************************************
63	*
64	* xdr_float.c, Generic XDR routine implementation.
65	*
66	* Copyright (C) 1984, Sun Microsystems, Inc.
67	*
68	* These are the "floating point" xdr routines used to (de)serialize
69	* most common data items. See xdr.h for more info on the interface to
70	* xdr.
71	*
72	* The MP Library is distributed in the hope that it will be useful,
73	* but without any warranty of any kind and without even the implied
74	* warranty of merchantability or fitness for a particular purpose.
75	*
76	**************************************************************************/
77
78
79	#include "MP.h"
80
81
82	static char filler[4]={0, 0, 0, 0};
83
84	/*
85	* these two defined in MP_Util.c
86	*/
87	EXTERN char fix_log_msg[];
88	EXTERN char AnnotFlagsStr[];
89
90
91	#ifdef __STDC__
92	MP_Status_t MP_PutAnnotationPacket(MP_Link_pt link,
93	MP_DictTag_t dtag,
94	MP_AnnotType_t atype,
95	MP_AnnotFlags_t flags)
96	#else
97	MP_Status_t MP_PutAnnotationPacket(link, dtag, atype, flags)
98	MP_Link_pt link;
99	MP_DictTag_t dtag;
100	MP_AnnotType_t atype;
101	MP_AnnotFlags_t flags;
102	#endif
103	{
104	MP_AnnotHeader_t annot = 0;
105
106	MP_SetAnnotTypeField(annot, atype);
107	MP_SetAnnotDictTagField(annot, dtag);
108	MP_SetAnnotFlagsField(annot, flags);
109
110	if (!IMP_PutLong(link, (long*)&annot))
111	return MP_SetError(link, MP_CantPutAnnotationPacket);
112
113	#ifndef NO_LOGGING
114	if (link->logmask & MP_LOG_WRITE_EVENTS) {
115	annot_flags_to_str(flags);
116	/* The following is acceptable only for now. Eventually I
117	must clearly identify the MP dictionary range. */
118	/* 3/28/97 - sgray - annotations are spread out through a variety
119	of header files, so giving a string version of the annotation
120	is not practical at this time. Maybe have they are stable we
121	can create function to do a (dtag, atype) mapping to a string. */
122	/* if (dtag == 0)
123	sprintf(fix_log_msg, "%-12s flags: %s dict: %lu ",
124	annotations[atype], AnnotFlagsStr, dtag);
125	else
126	*/
127	sprintf(fix_log_msg, "AnnotPkt dict: %lu atype: %u flags: %s",
128	dtag, atype, AnnotFlagsStr);
129	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
130	}
131	#endif
132
133	return MP_ClearError(link);
134	}
135
136	/* this is a private version of the IMP_PutNodeHeader() routine
137	* IMPORTANT: At this time we have not determined how dictionary
138	* tags beyond 255 should be allocated. The code below make NO
139	* check to see if dtag is 127 or 255 (the indicators telling us
140	* the read in another 4 bytes with the true tag. Once we know
141	* how those tags will be disbursed, we can do the proper check
142	* here. To be clear. The problem is that if the incoming dtag
143	* is > 255, we can't yet identify it as MP-extended or user-extended,
144	* so can't know whether to use 127 or 255. It might be a good
145	* idea to combine these into a single "extended tag" and just
146	* divy up the 4 byte tags as well. This has to be fixed for
147	* imp_get_node_header() as well.
148	*/
149	#ifdef __STDC__
150	static MP_Status_t imp_put_node_header(MP_Link_pt link,
151	MP_NodeType_t ntype,
152	MP_DictTag_t dtag,
153	MP_Common_t cval,
154	MP_NumAnnot_t num_annots,
155	MP_NumChild_t num_child)
156	#else
157	static MP_Status_t imp_put_node_header(link, ntype, dtag, cval, num_annots,
158	num_child)
159	MP_Link_pt link;
160	MP_NodeType_t ntype;
161	MP_DictTag_t dtag;
162	MP_Common_t cval;
163	MP_NumAnnot_t num_annots;
164	MP_NumChild_t num_child;
165	#endif
166	{
167	MP_NodeHeader_t hdr = 0;
168
169	#ifdef MP_DEBUG
170	fprintf(stderr,
171	"imp_put_node_header: entering - ntype = %d, num_child = %d\n",
172	ntype, num_child);
173	#endif
174
175	if (link == NULL)
176	return MP_SetError(link, MP_NullLink);
177
178	MP_SetNodeTypeField(hdr, ntype);
179	MP_SetNodeCommonValueField(hdr, cval);
180	MP_SetNodeDictTagField(hdr, dtag); /* see important note above */
181
182	if (num_child != 0)
183	if (num_child < MP_ExtraFieldIndicator)
184	MP_SetNodeNumChildField(hdr, num_child);
185	else
186	MP_SetNodeExtraChildField(hdr);
187
188	if (num_annots != 0)
189	if (num_annots < MP_ExtraFieldIndicator)
190	MP_SetNodeNumAnnotsField(hdr, num_annots);
191	else
192	MP_SetNodeExtraAnnotsField(hdr);
193
194	if (!IMP_PutLong(link, (long *)&hdr))
195	return MP_SetError(link, MP_CantPutNodeHeader);
196
197	/* see if there is an extra number of children field to send */
198	if (num_child >= MP_ExtraFieldIndicator
199	&& !IMP_PutLong(link, (long*)&num_child))
200	return MP_SetError(link, MP_CantPutNodeHeader);
201
202	/* see if there is an extra number of annotations field to send */
203	if (num_annots >= MP_ExtraFieldIndicator
204	&& !IMP_PutLong(link, (long*)&num_annots))
205	return MP_SetError(link, MP_CantPutNodeHeader);
206
207	#ifdef MP_DEBUG
208	fprintf(stderr,
209	"imp_put_node_header: exiting - hdr = 0x%X, \ttype = %d\tnum_child"
210	" = %d\tnum_annot = %d\n",
211	hdr, ntype, num_child, num_annots);
212	#endif
213
214	return MP_ClearError(link);
215	}
216
217
218
219	/*
220	* This is what the programmer sees through the API. But we just call the
221	* private version above, then do the logging (if enabled).
222	*/
223	#ifdef __STDC__
224	MP_Status_t IMP_PutNodeHeader(MP_Link_pt link,
225	MP_NodeType_t ntype,
226	MP_DictTag_t dtag,
227	MP_Common_t cval,
228	MP_NumAnnot_t num_annots,
229	MP_NumChild_t num_child)
230	#else
231	MP_Status_t IMP_PutNodeHeader(link, ntype, dtag, cval, num_annots, num_child)
232	MP_Link_pt link;
233	MP_NodeType_t ntype;
234	MP_DictTag_t dtag;
235	MP_Common_t cval;
236	MP_NumAnnot_t num_annots;
237	MP_NumChild_t num_child;
238	#endif
239	{
240	imp_put_node_header(link, ntype, dtag, cval, num_annots, num_child);
241
242	#ifndef NO_LOGGING
243	if (link->logmask & MP_LOG_WRITE_EVENTS) {
244	sprintf(fix_log_msg,
245	"%-12s %-12s annots: %lu args: %lu dict: %lu cval: %u",
246	"NodePktHdr", IMP_TypeToString(ntype), num_annots,
247	num_child, dtag, cval);
248	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
249	}
250	#endif
251
252	return MP_ClearError(link);
253	}
254
255
256
257
258	#ifdef __STDC__
259	MP_Status_t IMP_PutSint32(MP_Link_pt link,
260	MP_Sint32_t n)
261	#else
262	MP_Status_t IMP_PutSint32(link, n)
263	MP_Link_pt link;
264	MP_Sint32_t n;
265	#endif
266	{
267	if (!IMP_PutLong(link, &n))
268	return MP_SetError(link, MP_CantPutDataPacket);
269
270	#ifndef NO_LOGGING
271	if (link->logmask & MP_LOG_WRITE_EVENTS)
272	log_fixnum(link, MP_WRITE_EVENT, "Sint32_DP", MP_Sint32Type, 0, &n);
273	#endif
274
275	return MP_ClearError(link);
276
277	}
278
279
280
281	#ifdef __STDC__
282	MP_Status_t IMP_PutUint32(MP_Link_pt link,
283	MP_Uint32_t n)
284	#else
285	MP_Status_t IMP_PutUint32(link, n)
286	MP_Link_pt link;
287	MP_Uint32_t n;
288	#endif
289	{
290	if (!IMP_PutLong(link, (long*)&n))
291	return MP_SetError(link, MP_CantPutDataPacket);
292
293	#ifndef NO_LOGGING
294	if (link->logmask & MP_LOG_WRITE_EVENTS)
295	log_fixnum(link, MP_WRITE_EVENT, "Uint32_DP", MP_Uint32Type, 0, &n);
296	#endif
297
298	return MP_ClearError(link);
299	}
300
301
302
303
304	#ifdef __STDC__
305	MP_Status_t IMP_PutRaw(MP_Link_pt link,
306	char *rawdata,
307	MP_Uint32_t len)
308	#else
309	MP_Status_t IMP_PutRaw(link, rawdata, len)
310	MP_Link_pt link;
311	char *rawdata;
312	MP_Uint32_t len;
313	#endif
314	{
315	unsigned long extra;
316
317	extra = len % MP_BytesPerMPUnit;
318	extra = MP_BytesPerMPUnit - extra;
319
320	if (!(IMP_PutLong(link, (long*)&len) && IMP_PutBytes(link, rawdata, len)))
321	return MP_SetError(link, MP_CantPutDataPacket);
322
323	if (extra != MP_BytesPerMPUnit /* have to pad with extra null bytes */
324	&& !IMP_PutBytes(link, filler, extra))
325	return MP_SetError(link, MP_CantPutDataPacket);
326
327	#ifndef NO_LOGGING
328	if (link->logmask & MP_LOG_WRITE_EVENTS) {
329	sprintf(fix_log_msg, "%-12s #bytes: %lu (data not shown)",
330	"Raw_DP", len);
331	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
332	}
333	#endif
334
335	return MP_ClearError(link);
336	}
337
338
339
340
341	#ifdef __STDC__
342	MP_Status_t IMP_PutString(MP_Link_pt link,
343	char *s)
344	#else
345	MP_Status_t IMP_PutString(link, s)
346	MP_Link_pt link;
347	char *s;
348	#endif
349	{
350	short extra;
351	unsigned long n;
352
353	n = strlen(s);
354	extra = n % MP_BytesPerMPUnit;
355	extra = MP_BytesPerMPUnit - extra;
356
357	if (! (IMP_PutLong(link, (long*)&n) && IMP_PutBytes(link, s, n)))
358	return MP_SetError(link, MP_CantPutDataPacket);
359
360	if (extra != MP_BytesPerMPUnit /* have to pad with extra null byres */
361	&& !IMP_PutBytes(link, filler, extra))
362	return MP_SetError(link, MP_CantPutDataPacket);
363
364	#ifndef NO_LOGGING
365	if (link->logmask & MP_LOG_WRITE_EVENTS) {
366	int len = strlen(s) + 36;
367	char *tmp_msg = IMP_MemAllocFnc(len);
368	sprintf(tmp_msg, "%-12s value: %s", "String_DP", s);
369	MP_LogEvent(link, MP_WRITE_EVENT, tmp_msg);
370	IMP_MemFreeFnc(tmp_msg, len);
371	}
372	#endif
373
374	return MP_ClearError(link);
375	}
376
377
378
379
380	#ifdef __STDC__
381	MP_Status_t common_put_string(MP_Link_pt link, char *s)
382	#else
383	MP_Status_t common_put_string(link, s)
384	MP_Link_pt link;
385	char *s;
386	#endif
387	{
388	short extra;
389	unsigned long n;
390
391	n = strlen(s);
392	extra = n % MP_BytesPerMPUnit;
393	extra = MP_BytesPerMPUnit - extra;
394
395	if (! (IMP_PutLong(link, (long*)&n) && IMP_PutBytes(link, s, n)))
396	return MP_SetError(link, MP_CantPutDataPacket);
397
398	if (extra != MP_BytesPerMPUnit /* have to pad with extra null byres */
399	&& !IMP_PutBytes(link, filler, extra))
400	return MP_SetError(link, MP_CantPutDataPacket);
401
402	return MP_ClearError(link);
403	}
404
405
406
407	#ifdef __STDC__
408	MP_Status_t MP_PutConstantPacket(MP_Link_pt link,
409	MP_DictTag_t dtag,
410	char *cnst,
411	MP_NumAnnot_t num_annots)
412	#else
413	MP_Status_t MP_PutConstantPacket(link, dtag, cnst, num_annots)
414	MP_Link_pt link;
415	MP_DictTag_t dtag;
416	char *cnst;
417	MP_NumAnnot_t num_annots;
418	#endif
419	{
420	if (! (imp_put_node_header(link, MP_ConstantType, dtag, 0, num_annots, 0)
421	&& common_put_string(link, cnst)))
422	return MP_SetError(link, MP_CantPutNodePacket);
423
424	#ifndef NO_LOGGING
425	if (link->logmask & MP_LOG_WRITE_EVENTS) {
426	sprintf(fix_log_msg, "%-12s annots: %lu dict: %lu value: %s",
427	"Constant_NP", num_annots, dtag, cnst);
428	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
429	}
430	#endif
431
432	return MP_ClearError(link);
433	}
434
435
436	#ifdef __STDC__
437	MP_Status_t MP_PutCommonLatinIdentifierPacket(MP_Link_pt link,
438	MP_DictTag_t dtag,
439	MP_Common_t id,
440	MP_NumAnnot_t num_annots)
441	#else
442	MP_Status_t MP_PutCommonLatinIdentifierPacket(link, dtag, id, num_annots)
443	MP_Link_pt link;
444	MP_DictTag_t dtag;
445	MP_Common_t id;
446	MP_NumAnnot_t num_annots;
447	#endif
448	{
449	if (!imp_put_node_header(link, MP_CommonLatinIdentifierType, dtag, id,
450	num_annots, 0))
451	return MP_SetError(link, MP_CantPutNodePacket);
452
453	#ifndef NO_LOGGING
454	if (link->logmask & MP_LOG_WRITE_EVENTS)
455	log_dicttype(link, MP_WRITE_EVENT, "Latin Id_NP",
456	MP_CommonLatinIdentifierType, num_annots, dtag, &id, 0);
457	#endif
458
459	return MP_ClearError(link);
460	}
461
462
463
464	#ifdef __STDC__
465	MP_Status_t MP_PutCommonGreekIdentifierPacket(MP_Link_pt link,
466	MP_DictTag_t dtag,
467	MP_Common_t id,
468	MP_NumAnnot_t num_annots)
469	#else
470	MP_Status_t MP_PutCommonGreekIdentifierPacket(link, dtag, id, num_annots)
471	MP_Link_pt link;
472	MP_DictTag_t dtag;
473	MP_Common_t id;
474	MP_NumAnnot_t num_annots;
475	#endif
476	{
477	if (!imp_put_node_header(link, MP_CommonGreekIdentifierType, dtag, id,
478	num_annots, 0))
479	return MP_SetError(link, MP_CantPutNodePacket);
480
481	#ifndef NO_LOGGING
482	if (link->logmask & MP_LOG_WRITE_EVENTS)
483	log_dicttype(link, MP_WRITE_EVENT, "Greek Id_NP",
484	MP_CommonGreekIdentifierType, num_annots, dtag, &id, 0);
485	#endif
486
487	return MP_ClearError(link);
488	}
489
490
491	#ifdef __STDC__
492	MP_Status_t MP_PutIdentifierPacket(MP_Link_pt link,
493	MP_DictTag_t dtag,
494	char *id,
495	MP_NumAnnot_t num_annots)
496	#else
497	MP_Status_t MP_PutIdentifierPacket(link, dtag, id, num_annots)
498	MP_Link_pt link;
499	MP_DictTag_t dtag;
500	char *id;
501	MP_NumAnnot_t num_annots;
502	#endif
503	{
504	if (!(imp_put_node_header(link, MP_IdentifierType, dtag, *id, num_annots, 0)
505	&& common_put_string(link, id)))
506	return MP_SetError(link, MP_CantPutNodePacket);
507
508	#ifndef NO_LOGGING
509	if (link->logmask & MP_LOG_WRITE_EVENTS) {
510	sprintf(fix_log_msg, "%-12s annots: %lu dict: %lu value: %s",
511	"Ident_NP", num_annots, dtag, id);
512	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
513	}
514	#endif
515
516	return MP_ClearError(link);
517	}
518
519
520
521	#ifdef __STDC__
522	MP_Status_t IMP_PutStringBasedTypePacket(MP_Link_pt link,
523	char *s,
524	MP_NumAnnot_t num_annots,
525	MP_NodeType_t ntype)
526	#else
527	MP_Status_t IMP_PutStringBasedTypePacket(link, s, num_annots, ntype)
528	MP_Link_pt link;
529	char *s;
530	MP_NumAnnot_t num_annots;
531	MP_NodeType_t ntype;
532	#endif
533	{
534	/*
535	* generic put routine for all string-based types
536	*/
537
538	#ifndef NO_LOGGING
539	char thetype = NULL; / for logging only */
540
541	if (link->logmask & MP_LOG_WRITE_EVENTS) {
542	if (ntype == MP_StringType)
543	thetype = "String_NP";
544	else if (ntype == MP_MetaType)
545	thetype = "Meta_NP";
546
547	sprintf(fix_log_msg, "%-12s %4lu %-24s", thetype,
548	num_annots, s);
549	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
550	}
551	#endif
552
553	if (!imp_put_node_header(link, ntype, 0, 0, num_annots, 0))
554	return MP_Failure;
555
556	if (!common_put_string(link, s))
557	return MP_SetError(link, MP_CantPutNodePacket);
558
559	return MP_ClearError(link);
560	}
561
562
563
564
565	#ifdef __STDC__
566	MP_Status_t MP_PutStringPacket(MP_Link_pt link,
567	char *s,
568	MP_NumAnnot_t num_annots)
569	#else
570	MP_Status_t MP_PutStringPacket(link, s, num_annots)
571	MP_Link_pt link;
572	char *s;
573	MP_NumAnnot_t num_annots;
574	#endif
575	{
576	if (!(imp_put_node_header(link, MP_StringType, 0, 0, num_annots, 0)
577	&& common_put_string(link, s)))
578	return MP_Failure;
579
580	#ifndef NO_LOGGING
581	if (link->logmask & MP_LOG_WRITE_EVENTS) {
582	int len = strlen(s) + 36;
583	char *tmp_msg = IMP_MemAllocFnc(len);
584	sprintf(tmp_msg, "%-12s annots: %lu value: %s", "String_NP",
585	num_annots, s);
586	MP_LogEvent(link, MP_WRITE_EVENT, tmp_msg);
587	IMP_MemFreeFnc(tmp_msg, len);
588	}
589	#endif
590
591	return MP_ClearError(link);
592	}
593
594
595
596
597	#ifdef __STDC__
598	MP_Status_t MP_PutMetaTypePacket(MP_Link_pt link,
599	MP_DictTag_t dtag,
600	char *s,
601	MP_NumAnnot_t num_annots)
602	#else
603	MP_Status_t MP_PutMetaTypePacket(link, dtag, s, num_annots)
604	MP_Link_pt link;
605	MP_DictTag_t dtag;
606	char *s;
607	MP_NumAnnot_t num_annots;
608	#endif
609	{
610	if (!(imp_put_node_header(link, MP_MetaType, dtag, 0, num_annots, 0)
611	&& common_put_string(link, s)))
612	return MP_Failure;
613
614	#ifndef NO_LOGGING
615	if (link->logmask & MP_LOG_WRITE_EVENTS) {
616	sprintf(fix_log_msg, "%-12s annots: %lu dict: %lu value: %s",
617	"MetaType_NP", num_annots, dtag, s);
618	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
619	}
620	#endif
621
622	return MP_ClearError(link);
623	}
624
625
626
627
628	#ifdef __STDC__
629	MP_Status_t MP_PutCommonOperatorPacket(MP_Link_pt link,
630	MP_DictTag_t dtag,
631	MP_Common_t op,
632	MP_NumAnnot_t num_annots,
633	MP_NumChild_t num_child)
634	#else
635	MP_Status_t MP_PutCommonOperatorPacket(link, dtag, op, num_annots, num_child)
636	MP_Link_pt link;
637	MP_DictTag_t dtag;
638	MP_Common_t op;
639	MP_NumAnnot_t num_annots;
640	MP_NumChild_t num_child;
641	#endif
642	{
643	if (!imp_put_node_header(link, MP_CommonOperatorType, dtag, op, num_annots,
644	num_child))
645	return MP_SetError(link, MP_CantPutNodePacket);
646
647	#ifndef NO_LOGGING
648	if (link->logmask & MP_LOG_WRITE_EVENTS) {
649	log_dicttype(link, MP_WRITE_EVENT, "Common Op_NP",
650	MP_CommonOperatorType,num_annots, dtag, &op, num_child);
651	}
652	#endif
653
654	return MP_ClearError(link);
655	}
656
657
658	#ifdef __STDC__
659	MP_Status_t MP_PutCommonMetaOperatorPacket(MP_Link_pt link,
660	MP_DictTag_t dtag,
661	MP_Common_t op,
662	MP_NumAnnot_t num_annots,
663	MP_NumChild_t num_child)
664	#else
665	MP_Status_t MP_PutCommonMetaOperatorPacket(link, dtag, op, num_annots,
666	num_child)
667	MP_Link_pt link;
668	MP_DictTag_t dtag;
669	MP_Common_t op;
670	MP_NumAnnot_t num_annots;
671	MP_NumChild_t num_child;
672	#endif
673	{
674	if (!imp_put_node_header(link, MP_CommonMetaOperatorType, dtag, op,
675	num_annots, num_child))
676	return MP_SetError(link, MP_CantPutNodePacket);
677
678	#ifndef NO_LOGGING
679	if (link->logmask & MP_LOG_WRITE_EVENTS) {
680	log_dicttype(link, MP_WRITE_EVENT, "Common MetaOp_NP",
681	MP_CommonMetaOperatorType,num_annots, dtag, &op, num_child);
682	}
683	#endif
684
685	return MP_ClearError(link);
686	}
687
688
689
690
691	#ifdef __STDC__
692	MP_Status_t MP_PutCommonMetaTypePacket(MP_Link_pt link,
693	MP_DictTag_t dtag,
694	MP_Common_t cm,
695	MP_NumAnnot_t num_annots)
696	#else
697	MP_Status_t MP_PutCommonMetaTypePacket(link, dtag, cm, num_annots)
698	MP_Link_pt link;
699	MP_DictTag_t dtag;
700	MP_Common_t cm;
701	MP_NumAnnot_t num_annots;
702	#endif
703	{
704	if (!imp_put_node_header(link, MP_CommonMetaType, dtag, cm,num_annots, 0))
705	return MP_SetError(link, MP_CantPutNodePacket);
706
707	#ifndef NO_LOGGING
708	if (link->logmask & MP_LOG_WRITE_EVENTS)
709	log_dicttype(link, MP_WRITE_EVENT, "Common Meta_NP", MP_CommonMetaType,
710	num_annots, dtag, &cm, 0);
711	#endif
712
713	return MP_ClearError(link);
714	}
715
716
717
718	#ifdef __STDC__
719	MP_Status_t MP_PutCommonConstantPacket(MP_Link_pt link,
720	MP_DictTag_t dtag,
721	MP_Common_t cnst,
722	MP_NumAnnot_t num_annots)
723	#else
724	MP_Status_t MP_PutCommonConstantPacket(link, dtag, cnst, num_annots)
725	MP_Link_pt link;
726	MP_DictTag_t dtag;
727	MP_Common_t cnst;
728	MP_NumAnnot_t num_annots;
729	#endif
730	{
731	if (!imp_put_node_header(link, MP_CommonConstantType, dtag, cnst,
732	num_annots, 0))
733	return MP_SetError(link, MP_CantPutNodePacket);
734
735	#ifndef NO_LOGGING
736	if (link->logmask & MP_LOG_WRITE_EVENTS)
737	log_dicttype(link, MP_WRITE_EVENT, "Common Cnst_NP",
738	MP_CommonConstantType, num_annots, dtag, &cnst, 0);
739	#endif
740
741	return MP_ClearError(link);
742	}
743
744
745
746
747	#ifdef __STDC__
748	MP_Status_t MP_PutOperatorPacket(MP_Link_pt link,
749	MP_DictTag_t dtag,
750	char *op,
751	MP_NumAnnot_t num_annots,
752	MP_NumChild_t num_child)
753	#else
754	MP_Status_t MP_PutOperatorPacket(link, dtag, op, num_annots, num_child)
755	MP_Link_pt link;
756	MP_DictTag_t dtag;
757	char *op;
758	MP_NumAnnot_t num_annots;
759	MP_NumChild_t num_child;
760	#endif
761	{
762	if (!(imp_put_node_header(link, MP_OperatorType, dtag, 0, num_annots,
763	num_child) && common_put_string(link, op)))
764	return MP_SetError(link, MP_CantPutNodePacket);
765
766	#ifndef NO_LOGGING
767	if (link->logmask & MP_LOG_WRITE_EVENTS)
768	log_dicttype(link, MP_WRITE_EVENT, "Operator_NP", MP_OperatorType,
769	num_annots, dtag, op, num_child);
770	#endif
771
772	return MP_ClearError(link);
773	}
774
775
776	#ifdef __STDC__
777	MP_Status_t MP_PutMetaOperatorPacket(MP_Link_pt link,
778	MP_DictTag_t dtag,
779	char *op,
780	MP_NumAnnot_t num_annots,
781	MP_NumChild_t num_child)
782	#else
783	MP_Status_t MP_PutMetaOperatorPacket(link, dtag, op, num_annots, num_child)
784	MP_Link_pt link;
785	MP_DictTag_t dtag;
786	char *op;
787	MP_NumAnnot_t num_annots;
788	MP_NumChild_t num_child;
789	#endif
790	{
791	if (!(imp_put_node_header(link, MP_MetaOperatorType, dtag, 0, num_annots,
792	num_child) && common_put_string(link, op)))
793	return MP_SetError(link, MP_CantPutNodePacket);
794
795	#ifndef NO_LOGGING
796	if (link->logmask & MP_LOG_WRITE_EVENTS)
797	log_dicttype(link, MP_WRITE_EVENT, "MetaOperator_NP", MP_MetaOperatorType,
798	num_annots, dtag, op, num_child);
799	#endif
800
801	return MP_ClearError(link);
802	}
803
804
805
806	#ifdef __STDC__
807	MP_Status_t IMP_PutOperator(MP_Link_pt link, char *op)
808	#else
809	MP_Status_t IMP_PutOperator(link, op)
810	MP_Link_pt link;
811	char *op;
812	#endif
813	{
814	if (!common_put_string(link, op))
815	return MP_Failure;
816
817	#ifndef NO_LOGGING
818	if (link->logmask & MP_LOG_WRITE_EVENTS) {
819	sprintf(fix_log_msg, "%-12s op: %s", "Operator_DP", op);
820	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
821	}
822	#endif
823
824	return MP_ClearError(link);
825	}
826
827
828	#ifdef __STDC__
829	MP_Status_t IMP_PutMetaOperator(MP_Link_pt link, char *op)
830	#else
831	MP_Status_t IMP_PutMetaOperator(link, op)
832	MP_Link_pt link;
833	char *op;
834	#endif
835	{
836	if (!common_put_string(link, op))
837	return MP_Failure;
838
839	#ifndef NO_LOGGING
840	if (link->logmask & MP_LOG_WRITE_EVENTS) {
841	sprintf(fix_log_msg, "%-12s op: %s", "MetaOperator_DP", op);
842	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
843	}
844	#endif
845
846	return MP_ClearError(link);
847	}
848
849
850	#ifdef __STDC__
851	MP_Status_t IMP_PutApInt(MP_Link_pt link, MP_ApInt_t apint)
852	#else
853	MP_Status_t IMP_PutApInt(link, apint)
854	MP_Link_pt link;
855	MP_ApInt_t apint;
856	#endif
857	{
858	#ifndef NO_LOGGING
859	if (link->logmask & MP_LOG_WRITE_EVENTS)
860	{
861	int len;
862	char *msg = NULL;
863	len = link->bignum.bigint_ops->bigint_ascii_size(apint) + 25;
864	msg = IMP_MemAllocFnc(len);
865	sprintf(msg, "%-12s value: ", "ApInt_DP");
866	link->bignum.bigint_ops->bigint_to_str(apint, &(msg[strlen(msg)]));
867	MP_LogEvent(link, MP_WRITE_EVENT, msg);
868	IMP_MemFreeFnc(msg, len);
869	}
870	#endif
871
872	if (link->bignum.bigint_ops->put_bigint(link, apint) != MP_Success)
873	return MP_SetError(link, MP_CantPutDataPacket);
874
875	return MP_ClearError(link);
876	}
877
878
879	#ifdef __STDC__
880	MP_Status_t MP_PutApIntPacket(MP_Link_pt link,
881	MP_ApInt_t apint,
882	MP_NumAnnot_t num_annots)
883	#else
884	MP_Status_t MP_PutApIntPacket(link, apint, num_annots)
885	MP_Link_pt link;
886	MP_ApInt_t apint;
887	MP_NumAnnot_t num_annots;
888	#endif
889	{
890	if (!imp_put_node_header(link, MP_ApIntType, 0, 0, num_annots, 0))
891	return MP_SetError(link, MP_CantPutNodePacket);
892
893	if (link->bignum.bigint_ops->put_bigint(link, apint) != MP_Success)
894	return MP_SetError(link, MP_CantPutNodePacket);
895
896	#ifndef NO_LOGGING
897	if (link->logmask & MP_LOG_WRITE_EVENTS)
898	{
899	int len;
900	char *msg = NULL;
901	len = link->bignum.bigint_ops->bigint_ascii_size(apint) + 42;
902	msg = IMP_MemAllocFnc(len);
903	sprintf(msg, "%-12s annots: %lu value: ", "ApInt_NP", num_annots);
904	link->bignum.bigint_ops->bigint_to_str(apint, &(msg[strlen(msg)]));
905	MP_LogEvent(link, MP_WRITE_EVENT, msg);
906	IMP_MemFreeFnc(msg, len);
907	}
908	#endif
909	return MP_ClearError(link);
910	}
911
912
913	#ifdef __STDC__
914	MP_Status_t IMP_PutApReal(MP_Link_pt link, MP_ApReal_t apreal)
915	#else
916	MP_Status_t IMP_PutApReal(link, apreal)
917	MP_Link_pt link;
918	MP_ApReal_t apreal;
919	#endif
920	{
921	#ifndef NO_LOGGING
922	if (link->logmask & MP_LOG_WRITE_EVENTS)
923	{
924	int len;
925	char *msg = NULL;
926	len = link->bignum.bigreal_ops->bigreal_ascii_size(apreal) + 25;
927	msg = IMP_MemAllocFnc(len);
928	sprintf(msg, "%-12s value: ", "ApReal_DP");
929	link->bignum.bigreal_ops->bigreal_to_str(apreal, &(msg[strlen(msg)]));
930	MP_LogEvent(link, MP_WRITE_EVENT, msg);
931	IMP_MemFreeFnc(msg, len);
932	}
933	#endif
934
935	if (link->bignum.bigreal_ops->put_bigreal(link, apreal) != MP_Success)
936	return MP_SetError(link, MP_CantPutDataPacket);
937
938	return MP_ClearError(link);
939	}
940
941
942
943	#ifdef __STDC__
944	MP_Status_t MP_PutApRealPacket(MP_Link_pt link,
945	MP_ApReal_t apreal,
946	MP_NumAnnot_t num_annots)
947	#else
948	MP_Status_t MP_PutApRealPacket(link, apreal, num_annots)
949	MP_Link_pt link;
950	MP_ApReal_t apreal;
951	MP_NumAnnot_t num_annots;
952	#endif
953	{
954	if (!imp_put_node_header(link, MP_ApRealType, 0, 0, num_annots, 0))
955	return MP_SetError(link, MP_CantPutNodePacket);
956
957	if (link->bignum.bigreal_ops->put_bigreal(link, apreal) != MP_Success)
958	return MP_SetError(link, MP_CantPutNodePacket);
959
960	#ifndef NO_LOGGING
961	if (link->logmask & MP_LOG_WRITE_EVENTS)
962	{
963	int len;
964	char *msg = NULL;
965	len = link->bignum.bigreal_ops->bigreal_ascii_size(apreal) + 45;
966	msg = IMP_MemAllocFnc(len);
967	sprintf(msg, "%-12s annots: %lu value: ", "ApReal_NP", num_annots);
968	link->bignum.bigreal_ops->bigreal_to_str(apreal, &(msg[strlen(msg)]));
969	MP_LogEvent(link, MP_WRITE_EVENT, msg);
970	IMP_MemFreeFnc(msg, len);
971	}
972	#endif
973
974	return MP_ClearError(link);
975	}
976
977
978	#ifdef __STDC__
979	MP_Status_t MP_PutBooleanPacket(MP_Link_pt link,
980	MP_Boolean_t mbool,
981	MP_NumAnnot_t num_annots)
982	#else
983	MP_Status_t MP_PutBooleanPacket(link, mbool, num_annots)
984	MP_Link_pt link;
985	MP_Boolean_t mbool;
986	MP_NumAnnot_t num_annots;
987	#endif
988	{
989	if (!imp_put_node_header(link, MP_BooleanType, 0, mbool, num_annots, 0))
990	return MP_SetError(link, MP_CantPutNodePacket);
991
992	#ifndef NO_LOGGING
993	if (link->logmask & MP_LOG_WRITE_EVENTS)
994	log_fixnum(link, MP_WRITE_EVENT, "Boolean_NP", MP_BooleanType,
995	num_annots, &mbool);
996	#endif
997
998	return MP_ClearError(link);
999	}
1000
1001
1002	#ifdef __STDC__
1003	MP_Status_t IMP_PutBoolean(MP_Link_pt link, MP_Boolean_t mbool)
1004	#else
1005	MP_Status_t IMP_PutBoolean(link, mbool)
1006	MP_Link_pt link;
1007	MP_Boolean_t mbool;
1008	#endif
1009	{
1010	if (!imp_put_node_header(link, MP_BooleanType, 0, mbool, 0, 0))
1011	return MP_SetError(link, MP_CantPutDataPacket);
1012
1013	#ifndef NO_LOGGING
1014	if (link->logmask & MP_LOG_WRITE_EVENTS)
1015	log_fixnum(link, MP_WRITE_EVENT, "Boolean_DP", MP_BooleanType, 0,
1016	&mbool);
1017	#endif
1018
1019	return MP_ClearError(link);
1020	}
1021
1022
1023	#ifdef __STDC__
1024	MP_Status_t MP_PutSint8Packet(MP_Link_pt link,
1025	MP_Sint8_t n,
1026	MP_NumAnnot_t num_annots)
1027	#else
1028	MP_Status_t MP_PutSint8Packet(link, n, num_annots)
1029	MP_Link_pt link;
1030	MP_Sint8_t n;
1031	MP_NumAnnot_t num_annots;
1032	#endif
1033	{
1034	if (!imp_put_node_header(link, MP_Sint8Type, 0, n, num_annots, 0))
1035	return MP_SetError(link, MP_CantPutDataPacket);
1036
1037	#ifndef NO_LOGGING
1038	if (link->logmask & MP_LOG_WRITE_EVENTS)
1039	log_fixnum(link, MP_WRITE_EVENT, "Sint8_NP", MP_Sint8Type,
1040	num_annots, &n);
1041	#endif
1042
1043	return MP_ClearError(link);
1044	}
1045
1046
1047	#ifdef __STDC__
1048	MP_Status_t MP_PutUint8Packet(MP_Link_pt link,
1049	MP_Uint8_t n,
1050	MP_NumAnnot_t num_annots)
1051	#else
1052	MP_Status_t MP_PutUint8Packet(link, n, num_annots)
1053	MP_Link_pt link;
1054	MP_Uint8_t n;
1055	MP_NumAnnot_t num_annots;
1056	#endif
1057	{
1058	/* need the following to make the HPs happy, otherwise it treats the
1059	incoming value as an unsigned integer (2 - 4 bytes)
1060	*/
1061	unsigned char x = (unsigned char) n;
1062
1063	if (!imp_put_node_header(link, MP_Uint8Type, 0, x, num_annots, 0))
1064	return MP_SetError(link, MP_CantPutDataPacket);
1065
1066	#ifndef NO_LOGGING
1067	if (link->logmask & MP_LOG_WRITE_EVENTS)
1068	log_fixnum(link, MP_WRITE_EVENT, "Uint8_NP", MP_Uint8Type,
1069	num_annots, &x);
1070	#endif
1071
1072	return MP_ClearError(link);
1073	}
1074
1075
1076	#ifdef __STDC__
1077	MP_Status_t IMP_PutSint8(MP_Link_pt link, MP_Sint8_t n)
1078	#else
1079	MP_Status_t IMP_PutSint8(link, n)
1080	MP_Link_pt link;
1081	MP_Sint8_t n;
1082	#endif
1083	{
1084	if (!imp_put_node_header(link, MP_Sint8Type, 0, n, 0, 0))
1085	return MP_SetError(link, MP_CantPutDataPacket);
1086
1087	#ifndef NO_LOGGING
1088	if (link->logmask & MP_LOG_WRITE_EVENTS)
1089	log_fixnum(link, MP_WRITE_EVENT, "Sint8_DP", MP_Sint8Type, 0, &n);
1090	#endif
1091
1092	return MP_ClearError(link);
1093	}
1094
1095
1096
1097	#ifdef __STDC__
1098	MP_Status_t IMP_PutUint8(MP_Link_pt link,
1099	MP_Uint8_t n)
1100	#else
1101	MP_Status_t IMP_PutUint8(link, n)
1102	MP_Link_pt link;
1103	MP_Uint8_t n;
1104	#endif
1105	{
1106	/* need the following to make the HPs happy, otherwise it treats the
1107	incoming value as an unsigned integer (2 - 4 bytes)
1108	*/
1109	unsigned char x = (unsigned char) n;
1110	if (!imp_put_node_header(link, MP_Uint8Type, 0, x, 0, 0))
1111	return MP_SetError(link, MP_CantPutDataPacket);
1112
1113	#ifndef NO_LOGGING
1114	if (link->logmask & MP_LOG_WRITE_EVENTS)
1115	log_fixnum(link, MP_WRITE_EVENT, "Uint8_DP", MP_Uint8Type, 0, &x);
1116	#endif
1117
1118	return MP_ClearError(link);
1119	}
1120
1121
1122	#ifdef __STDC__
1123	MP_Status_t MP_PutSint32Packet(MP_Link_pt link,
1124	MP_Sint32_t n,
1125	MP_NumAnnot_t num_annots)
1126	#else
1127	MP_Status_t MP_PutSint32Packet(link, n, num_annots)
1128	MP_Link_pt link;
1129	MP_Sint32_t n;
1130	MP_NumAnnot_t num_annots;
1131	#endif
1132	{
1133	if (! (imp_put_node_header(link, MP_Sint32Type, 0, 0, num_annots, 0)
1134	&& IMP_PutLong(link, &n)))
1135	return MP_SetError(link, MP_CantPutDataPacket);
1136
1137	#ifndef NO_LOGGING
1138	if (link->logmask & MP_LOG_WRITE_EVENTS)
1139	log_fixnum(link, MP_WRITE_EVENT,"Sint32_NP",MP_Sint32Type,
1140	num_annots, &n);
1141	#endif
1142
1143	return MP_ClearError(link);
1144	}
1145
1146
1147	#ifdef __STDC__
1148	MP_Status_t MP_PutUint32Packet(MP_Link_pt link,
1149	MP_Uint32_t n,
1150	MP_NumAnnot_t num_annots)
1151	#else
1152	MP_Status_t MP_PutUint32Packet(link, n, num_annots)
1153	MP_Link_pt link;
1154	MP_Uint32_t n;
1155	MP_NumAnnot_t num_annots;
1156	#endif
1157	{
1158	if (! (imp_put_node_header(link, MP_Uint32Type, 0, 0, num_annots, 0)
1159	&& IMP_PutLong(link, (long*)&n)))
1160	return MP_SetError(link, MP_CantPutDataPacket);
1161
1162	#ifndef NO_LOGGING
1163	if (link->logmask & MP_LOG_WRITE_EVENTS)
1164	log_fixnum(link, MP_WRITE_EVENT,"Uint32_NP",MP_Uint32Type,
1165	num_annots, &n);
1166	#endif
1167
1168	return MP_ClearError(link);
1169	}
1170
1171
1172	#ifdef __STDC__
1173	MP_Status_t MP_PutRawPacket(MP_Link_pt link,
1174	char *data,
1175	MP_Uint32_t len,
1176	MP_NumAnnot_t num_annots)
1177	#else
1178	MP_Status_t MP_PutRawPacket(link, data, len, num_annots)
1179	MP_Link_pt link;
1180	char *data;
1181	MP_Uint32_t len;
1182	MP_NumAnnot_t num_annots;
1183	#endif
1184	{
1185	short extra;
1186
1187	if (!imp_put_node_header(link, MP_RawType, 0, 0, num_annots, 0))
1188	return MP_Failure;
1189
1190	extra = len % MP_BytesPerMPUnit;
1191	extra = MP_BytesPerMPUnit - extra;
1192
1193	if (! (IMP_PutLong(link, (long*)&len) && IMP_PutBytes(link, data, len)))
1194	return MP_SetError(link, MP_CantPutNodePacket);
1195
1196	if (extra != MP_BytesPerMPUnit /* have to pad with extra null bytes */
1197	&& !IMP_PutBytes(link, filler, extra))
1198	return MP_SetError(link, MP_CantPutNodePacket);
1199
1200	#ifndef NO_LOGGING
1201	if (link->logmask & MP_LOG_WRITE_EVENTS) {
1202	sprintf(fix_log_msg,
1203	"%-12s annots: %lu #bytes: %lu (data not shown)",
1204	"Raw_NP", num_annots, len);
1205	MP_LogEvent(link, MP_WRITE_EVENT, fix_log_msg);
1206	}
1207	#endif
1208
1209	return MP_ClearError(link);
1210	}
1211
1212
1213	/*
1214	* NB: Not portable.
1215	* This routine works on Suns (Sky / 68000's) and Vaxen.
1216	*/
1217	#ifdef vax
1218	/* What IEEE single precision floating point looks like on a Vax */
1219	struct ieee_single {
1220	unsigned int mantissa : 23;
1221	unsigned int exp : 8;
1222	unsigned int sign : 1;
1223	};
1224
1225	/* Vax single precision floating point */
1226	struct vax_single {
1227	unsigned int mantissa1 : 7;
1228	unsigned int exp : 8;
1229	unsigned int sign : 1;
1230	unsigned int mantissa2 : 16;
1231
1232	};
1233
1234	#define VAX_SNG_BIAS 0x81
1235	#define IEEE_SNG_BIAS 0x7f
1236
1237	static struct sgl_limits {
1238	struct vax_single s;
1239	struct ieee_single ieee;
1240	} sgl_limits[2] = {
1241	{{ 0x3f, 0xff, 0x0, 0xffff }, /* Max Vax */
1242	{ 0x0, 0xff, 0x0 }}, /* Max IEEE */
1243	{{ 0x0, 0x0, 0x0, 0x0 }, /* Min Vax */
1244	{ 0x0, 0x0, 0x0 }} /* Min IEEE */
1245	};
1246
1247	#endif
1248
1249
1250
1251	#ifdef __STDC__
1252	MP_Status_t IMP_PutReal32(MP_Link_pt link, MP_Real32_t n)
1253	#else
1254	MP_Status_t IMP_PutReal32(link, n)
1255	MP_Link_pt link;
1256	MP_Real32_t n;
1257	#endif
1258	{
1259	float x = n;
1260	float *fp = &x;
1261	#ifdef vax
1262	struct ieee_single is;
1263	struct vax_single vs, *vsp;
1264	struct sgl_limits *lim;
1265	#endif
1266
1267	#ifdef MP_DEBUGGING
1268	fprintf(stderr, "IMP_PutReal32: entering, fp = %-20.10G\n", *fp);
1269	#endif
1270
1271	#ifndef NO_LOGGING
1272	if (link->logmask & MP_LOG_WRITE_EVENTS)
1273	log_fixreal(link, MP_WRITE_EVENT, "Real32_DP", MP_Real32Type, 0, fp);
1274	#endif
1275
1276	#ifndef vax
1277	return IMP_PutLong(link, (long *)fp);
1278	#else /* not vax */
1279	vs = ((struct vax_single )fp);
1280	for (i = 0, lim = sgl_limits;
1281	i < sizeof(sgl_limits)/sizeof(struct sgl_limits); i++, lim++)
1282	if (vs.mantissa2 == lim->s.mantissa2
1283	&& vs.exp == lim->s.exp
1284	&& vs.mantissa1 == lim->s.mantissa1) {
1285	is = lim->ieee;
1286	goto shipit;
1287	}
1288
1289	is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS;
1290	is.mantissa = (vs.mantissa1 << 16) \| vs.mantissa2;
1291
1292	shipit:
1293	is.sign = vs.sign;
1294	return IMP_PutLong(link, (long *)&is);
1295	#endif /* not vax */
1296	}
1297
1298
1299
1300	/*
1301	* This routine works on Suns (Sky / 68000's) and Vaxen.
1302	*/
1303
1304	#ifdef vax
1305
1306	/* What IEEE double precision floating point looks like on a Vax */
1307	struct ieee_double {
1308	unsigned int mantissa1 : 20;
1309	unsigned int exp : 11;
1310	unsigned int sign : 1;
1311	unsigned int mantissa2 : 32;
1312	};
1313
1314	/* Vax double precision floating point */
1315	struct vax_double {
1316	unsigned int mantissa1 : 7;
1317	unsigned int exp : 8;
1318	unsigned int sign : 1;
1319	unsigned int mantissa2 : 16;
1320	unsigned int mantissa3 : 16;
1321	unsigned int mantissa4 : 16;
1322	};
1323
1324	#define VAX_DBL_BIAS 0x81
1325	#define IEEE_DBL_BIAS 0x3ff
1326	#define MASK(nbits) ((1 << nbits) - 1)
1327
1328	static struct dbl_limits {
1329	struct vax_double d;
1330	struct ieee_double ieee;
1331	} dbl_limits[2] = {
1332	{{ 0x7f, 0xff, 0x0, 0xffff, 0xffff, 0xffff }, /* Max Vax */
1333	{ 0x0, 0x7ff, 0x0, 0x0 }}, /* Max IEEE */
1334	{{ 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}, /* Min Vax */
1335	{ 0x0, 0x0, 0x0, 0x0 }} /* Min IEEE */
1336	};
1337
1338	#endif /* vax */
1339
1340
1341	#ifdef __STDC__
1342	MP_Status_t IMP_PutReal64(MP_Link_pt link, MP_Real64_t n)
1343	#else
1344	MP_Status_t IMP_PutReal64(link, n)
1345	register MP_Link_pt link;
1346	MP_Real64_t n;
1347	#endif
1348	{
1349	register long *lp;
1350	register double *dp = &n;
1351
1352	#ifdef vax
1353	struct ieee_double id;
1354	struct vax_double vd;
1355	register struct dbl_limits *lim;
1356	#endif
1357
1358	#ifdef MP_DEBUGGING
1359	fprintf(stderr, "IMP_PutReal64: entering, dp = %-20.10G\n", *dp);
1360	#endif
1361
1362	#ifndef NO_LOGGING
1363	if (link->logmask & MP_LOG_WRITE_EVENTS)
1364	log_fixreal(link, MP_WRITE_EVENT, "Real64_DP", MP_Real64Type, 0, dp);
1365	#endif
1366
1367	#ifndef vax
1368	lp = (long *)dp;
1369	#else /* not vax */
1370	vd = ((struct vax_double )dp);
1371	for (i = 0, lim = dbl_limits;
1372	i < sizeof(dbl_limits)/sizeof(struct dbl_limits); i++, lim++)
1373	if (vd.mantissa4 == lim->d.mantissa4
1374	&& vd.mantissa3 == lim->d.mantissa3
1375	&& vd.mantissa2 == lim->d.mantissa2
1376	&& vd.mantissa1 == lim->d.mantissa1
1377	&& vd.exp == lim->d.exp) {
1378	id = lim->ieee;
1379	goto shipit;
1380	}
1381
1382	id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS;
1383	id.mantissa1 = (vd.mantissa1 << 13) \| (vd.mantissa2 >> 3);
1384	id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29)
1385	\| (vd.mantissa3 << 13) \| ((vd.mantissa4 >> 3) & MASK(13));
1386
1387	shipit:
1388	id.sign = vd.sign;
1389	lp = (long *)&id;
1390	#endif /* not vax */
1391
1392	#ifdef WORDS_BIGENDIAN
1393	return IMP_PutLong(link, lp++) && IMP_PutLong(link, lp);
1394	#else /* not WORDS_BIGENDIAN */
1395	return IMP_PutLong(link, lp+1) && IMP_PutLong(link, lp);
1396	#endif /* not WORDS_BIGENDIAN */
1397	}
1398
1399
1400
1401	#ifdef __STDC__
1402	MP_Status_t MP_PutReal32Packet(MP_Link_pt link,
1403	MP_Real32_t n,
1404	MP_NumAnnot_t num_annots
1405	)
1406	#else
1407	MP_Status_t MP_PutReal32Packet(link, n, num_annots)
1408	MP_Link_pt link;
1409	MP_Real32_t n;
1410	MP_NumAnnot_t num_annots;
1411	#endif
1412	{
1413	#ifdef vax
1414	struct ieee_single is;
1415	struct vax_single vs, *vsp;
1416	struct sgl_limits *lim;
1417	#endif
1418	float x = n;
1419	float *fp = &x;
1420
1421	#ifndef NO_LOGGING
1422	if (link->logmask & MP_LOG_WRITE_EVENTS)
1423	log_fixreal(link, MP_WRITE_EVENT,
1424	"Real32_NP", MP_Real32Type, num_annots, fp);
1425	#endif
1426
1427	if (!imp_put_node_header(link, MP_Real32Type, 0, 0, num_annots, 0))
1428	return MP_SetError(link, MP_CantPutNodePacket);
1429
1430	#ifndef vax
1431	return IMP_PutLong(link, (long *)fp);
1432	#else /* not vax */
1433	vs = ((struct vax_single )fp);
1434	for (i = 0, lim = sgl_limits;
1435	i < sizeof(sgl_limits)/sizeof(struct sgl_limits); i++, lim++)
1436	if (vs.mantissa2 == lim->s.mantissa2
1437	&& vs.exp == lim->s.exp
1438	&& vs.mantissa1 == lim->s.mantissa1) {
1439	is = lim->ieee;
1440	goto shipit;
1441	}
1442
1443	is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS;
1444	is.mantissa = (vs.mantissa1 << 16) \| vs.mantissa2;
1445
1446	shipit:
1447	is.sign = vs.sign;
1448	return IMP_PutLong(link, (long *)&is);
1449	#endif /* not vax */
1450	}
1451
1452
1453	#ifdef __STDC__
1454	MP_Status_t MP_PutReal64Packet(MP_Link_pt link,
1455	MP_Real64_t n,
1456	MP_NumAnnot_t num_annots
1457	)
1458	#else
1459	MP_Status_t MP_PutReal64Packet(link, n, num_annots)
1460	MP_Link_pt link;
1461	MP_Real64_t n;
1462	MP_NumAnnot_t num_annots;
1463	#endif
1464	{
1465	register long *lp;
1466	register double *dp = &n;
1467
1468	#ifdef vax
1469	struct ieee_double id;
1470	struct vax_double vd;
1471	register struct dbl_limits *lim;
1472	#endif /* vax */
1473
1474	#ifndef NO_LOGGING
1475	if (link->logmask & MP_LOG_WRITE_EVENTS)
1476	log_fixreal(link, MP_WRITE_EVENT,
1477	"Real64_NP", MP_Real64Type, num_annots, dp);
1478	#endif
1479
1480	if (!imp_put_node_header(link, MP_Real64Type, 0, 0, num_annots, 0))
1481	return MP_SetError(link, MP_CantPutNodePacket);
1482
1483	#ifndef vax
1484	lp = (long *)dp;
1485	#else /* not vax */
1486	vd = ((struct vax_double )dp);
1487	for (i = 0, lim = dbl_limits;
1488	i < sizeof(dbl_limits)/sizeof(struct dbl_limits); i++, lim++)
1489	if (vd.mantissa4 == lim->d.mantissa4
1490	&& vd.mantissa3 == lim->d.mantissa3
1491	&& vd.mantissa2 == lim->d.mantissa2
1492	&& vd.mantissa1 == lim->d.mantissa1
1493	&& vd.exp == lim->d.exp) {
1494	id = lim->ieee;
1495	goto shipit;
1496	}
1497
1498	id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS;
1499	id.mantissa1 = (vd.mantissa1 << 13) \| (vd.mantissa2 >> 3);
1500	id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29)
1501	\| (vd.mantissa3 << 13) \| ((vd.mantissa4 >> 3) & MASK(13));
1502
1503	shipit:
1504	id.sign = vd.sign;
1505	lp = (long *)&id;
1506	#endif /* not vax */
1507
1508	#ifdef WORDS_BIGENDIAN
1509	return IMP_PutLong(link, lp++) && IMP_PutLong(link, lp);
1510	#else /* WORDS_BIGENDIAN */
1511	return IMP_PutLong(link, lp+1) && IMP_PutLong(link, lp);
1512	#endif /* WORDS_BIGENDIAN */
1513	}
1514
1515

Note: See TracBrowser for help on using the repository browser.

Download in other formats: