[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[dennou-ruby:000965] msgdmp for CDCL
锟解抖(FIP)锟酵★拷锟斤拷锟酵★拷
锟斤拷欠锟斤拷扦锟斤拷锟�
锟斤拷锟斤拷锟斤拷锟剿撅拷锟斤拷皮蓼锟斤拷锟� CDCL 锟剿わ拷锟斤拷锟斤拷 msgdmp_ 锟斤拷锟斤拷锟截わ拷锟斤拷墙锟剿わ拷锟斤拷
锟斤拷扦锟斤拷锟斤拷锟斤拷锟绞拷扦锟斤拷蓼锟斤拷锟斤拷韦恰锟絛cl-5.2C 锟窖のパッワ拷锟斤拷藕锟秸わ拷锟睫わ拷锟斤拷
cd src/math1/syslib 锟斤拷锟狡帮拷锟狡てわ拷锟斤拷锟斤拷锟斤拷锟斤拷锟窖ッワ拷锟轿猴拷锟斤拷锟斤拷撕锟斤拷旒拷锟�
锟斤拷锟绞わ拷锟轿で★拷syslib 锟捷わ拷锟饺わ拷藕锟秸わ拷锟睫わ拷锟斤拷锟斤拷锟斤拷锟斤拷皮撙皮锟斤拷锟斤拷锟斤拷锟斤拷锟�
锟狡るこ锟饺は筹拷千锟斤拷锟睫わ拷锟斤拷锟斤拷锟斤拷锟斤拷锟绞みに猴拷锟斤拷锟斤拷稀锟斤拷扭锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷盲锟斤拷钎锟�
锟届ク锟饺リ〖锟斤拷 ../syslib.old 锟饺わ拷锟狡★拷锟绞诧拷锟轿よう锟剿わ拷锟睫わ拷锟斤拷锟斤拷
% diff -c -r -N ../syslib.old . > ! ../patch-syslib
锟斤拷锟教わ拷锟斤拷锟斤拷锟斤拷扦锟斤拷锟斤拷韦锟斤拷胜锟斤拷锟�
锟斤拷锟狡★拷锟斤拷锟斤拷摔锟斤拷 RubyDCL 锟剿わ拷锟斤拷锟狡は★拷ruby 锟窖のワ拷锟介〖锟较ワ拷丧锟斤拷
锟截匡拷锟斤拷锟街わ拷锟斤拷锟斤拷锟诫こ锟饺で★拷锟斤拷锟斤拷锟斤拷位锟斤拷瞳锟斤拷锟杰に癸拷锟绞わ拷锟狡貉わ拷瑜︼拷摔锟�
锟斤拷蓼锟斤拷锟斤拷锟斤拷摔锟斤拷韦锟斤拷锟轿プワ拷锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷预锟斤拷蓼锟斤拷锟斤拷韦恰胜趣锟斤拷锟斤拷锟斤拷锟�
锟斤拷锟斤拷丐锟斤拷违匹锟斤拷趣锟� RubyDCL 锟角乖っわ拷锟剿★拷CDCL 锟轿ほわ拷锟斤拷锟斤拷锟矫プデ★拷锟斤拷
锟斤拷锟斤拷锟叫蝗わ拷锟斤拷瑜︼拷摔胜锟睫わ拷锟斤拷锟斤拷钎靴氓锟斤拷畏锟斤拷锟轿拷锟斤拷蓼锟斤拷锟斤拷宓拷锟�
CDCL 锟斤拷锟窖癸拷锟斤拷预盲锟斤拷锟轿わ拷锟斤拷辍硷拷锟斤拷锟斤拷锟斤拷小锟斤拷锟斤拷锟斤拷锟斤拷趣吖锟斤拷撙锟斤拷锟斤拷锟�
锟阶わ拷锟睫わ拷锟斤拷
锟解抖锟斤拷锟襟、わ拷锟斤拷锟斤拷锟斤拷锟斤拷锟斤け锟角★拷锟斤拷锟斤拷锟斤拷趣吖锟斤拷锟斤拷锟斤拷韦锟斤拷辍硷拷锟斤拷锟斤拷锟斤拷锟�
锟轿でわ拷锟斤拷锟斤拷锟斤拷锟竭の呵匡拷锟斤拷
ftp://www.gfd-dennou.org/arch/dcl/dcl-5.2-C.tar.gz 锟斤拷锟介、锟斤拷锟斤拷锟�
锟饺でもそ锟斤拷锟斤拷钎锟斤拷氓抓恰锟斤拷趣锟斤拷皮锟斤拷锟绞拷悉锟斤拷锟睫わ拷锟斤拷锟斤拷锟解し锟斤拷锟斤拷肖锟斤拷锟�
锟斤拷羌锟斤拷锟斤拷锟角ワ拷辍硷拷锟斤拷锟斤拷皮锟斤拷锟斤拷锟斤拷锟斤拷锟絝tp锟轿帮拷锟� cp 锟斤拷锟斤拷韦锟� dcl 锟斤拷
锟诫〖锟阶わ拷锟斤拷胜锟斤拷冉锟斤拷锟绞わ拷锟轿で★拷茂锟斤拷锟剿わ拷盲锟斤拷悚わ拷蓼锟斤拷绀︼拷锟斤拷锟矫拷锟斤拷锟�
锟斤拷锟斤拷锟绞わ拷锟轿で★拷驴嘶锟轿とわ拷锟斤拷锟斤拷锟斤拷锟斤拷锟绞わ拷锟斤拷锟斤拷锟接わ拷锟斤拷恰恕锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷锟�
锟斤拷锟斤拷锟斤拷藕锟秸わ拷 tar.gz 锟秸ワ拷锟斤拷锟斤拷锟饺わ拷锟叫★拷syslib 锟斤拷荬锟斤拷锟斤拷证锟斤拷锟斤拷锟斤拷锟�
锟叫わ拷锟斤拷锟角わ拷锟斤拷锟睫わ拷锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷氓抓恰锟斤拷趣锟斤拷皮胜锟斤拷锟斤拷稀锟絝tp锟斤拷
锟轿斤拷锟斤拷锟较わ拷锟斤拷锟斤拷枪预锟斤拷蓼锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷锟剿わ拷锟狡も、锟斤拷锟斤拷锟斤拷摔锟斤拷锟斤拷懿趣丐锟�
锟斤拷锟斤拷锟竭はわ拷锟疥い锟斤拷锟睫わ拷锟斤拷锟斤拷锟斤拷恕锟斤拷锟斤拷 SunOS 2.6 + gcc 锟角わ拷锟斤拷锟斤拷千
锟斤拷锟狡なわ拷锟轿で★拷锟斤拷锟斤拷锟斤拷锟狡帮拷锟斤拷千锟斤拷锟斤拷皮锟斤拷锟斤拷亩锟斤拷扦纬锟角э拷猡拷辘わ拷锟斤拷锟�
锟斤拷锟斤拷
锟斤拷欠锟斤拷 锟斤拷 horinout@xxxxxx
锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷锟斤拷锟饺彩池革拷锟芥セ锟襟タ★拷 611-0011 锟斤拷锟斤拷锟皆皋ワ拷锟斤拷
diff -c -r -N /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/Makefile ./Makefile
*** /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/Makefile Wed Aug 1 18:41:02 2001
--- ./Makefile Fri Nov 30 20:47:55 2001
***************
*** 40,45 ****
--- 40,49 ----
@xxxxxx -e "s!@xxxxxx!$(DBASEDIR)/!" \
glcqnp.g > glcqnp.c
+ msgdmp.o: msgdmp.c
+ msgdmp.c:
+ msgdmp_modify.csh
+
install: archive ranlib
archive:
diff -c -r -N /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp.c ./msgdmp.c
*** /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp.c Wed Aug 1 18:41:02 2001
--- ./msgdmp.c Fri Nov 30 20:48:37 2001
***************
*** 15,22 ****
/* ----------------------------------------------------------------------- */
/* Copyright (C) 2000 GFD Dennou Club. All rights reserved. */
/* ----------------------------------------------------------------------- */
! /* Subroutine */ int msgdmp_(char *clev, char *csub, char *cmsg, ftnlen
! clev_len, ftnlen csub_len, ftnlen cmsg_len)
{
/* Initialized data */
--- 15,22 ----
/* ----------------------------------------------------------------------- */
/* Copyright (C) 2000 GFD Dennou Club. All rights reserved. */
/* ----------------------------------------------------------------------- */
! /* Subroutine */ int msgdmp_dclorig(char *clev, char *csub, char *cmsg, int
! clev_len, int csub_len, int cmsg_len)
{
/* Initialized data */
***************
*** 132,134 ****
--- 132,276 ----
return 0;
} /* msgdmp_ */
+ /* ----------------------------------------------------
+ * switchable MSGDMP by T. Horinouchi 2001/11/30
+ *
+ * function msgdmp_ in the following is to be used in place of
+ * the original msgdmp_, which is renamed as msgdmp_dclorig above.
+ * the new msgdmp_ calls msgdmp_func whose default value is
+ * msgdmp_dclorig. Thus, the default behavior the msgdmp_ is the same
+ * as before. However, msgdmp_func can be replaced by using
+ * set_msgdmp_func. Also, only the behaviour on error can be modified
+ * with set_mgsdmp_err.
+ * ---------------------------------------------------- */
+
+ static int (*msgdmp_func)(char *clev, char *csub, char *cmsg,
+ int clev_len, int csub_len, int cmsg_len)
+ = msgdmp_dclorig ; /* <-- default function */
+
+ static int (*msgdmp_err_func)(char *csub, char *cmsg,
+ int csub_len, int cmsg_len); /* no default */
+
+ static int msgdmp_err_replaceable (char *, char *, char *, int, int, int);
+ /* ^ defined below */
+
+ int set_msgdmp_func( int (*f)(char *clev, char *csub, char *cmsg,
+ int clev_len, int csub_len, int cmsg_len) )
+ {
+ msgdmp_func = f;
+ }
+
+ int set_msgdmp_err_func( int (*f)(char *csub, char *cmsg,
+ int csub_len, int cmsg_len) )
+ {
+ msgdmp_err_func = f;
+ msgdmp_func = msgdmp_err_replaceable;
+ }
+
+ int msgdmp_(char *clev, char *csub, char *cmsg, ftnlen
+ clev_len, ftnlen csub_len, ftnlen cmsg_len)
+ {
+ return( (*msgdmp_func)(clev, csub, cmsg,
+ clev_len, csub_len, cmsg_len) );
+ }
+
+ static int msgdmp_err_replaceable(char *clev, char *csub, char *cmsg, int
+ clev_len, int csub_len, int cmsg_len)
+ /* msgdmp_err_replaceable: by T Horinouchi 2001/11/30
+ same as msgdmp_dclorig except that msgdmp_err_func (to be set
+ by set_msgdmp_err_func) is called on error */
+ {
+ /* Initialized data */
+
+ static integer imsg = 0;
+
+ /* System generated locals */
+ address a__1[6], a__2[4];
+ integer i__1, i__2[6], i__3[4];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
+ char **, integer *, integer *, ftnlen), s_stop(char *, ftnlen);
+
+ /* Local variables */
+ extern integer lenc_(char *, ftnlen);
+ static char cprc[32];
+ static integer lprc, lmsg, nlev, lsub;
+ static logical llmsg;
+ static char clevx[1], cmsgx[200], csubx[32];
+ static integer iunit;
+ extern /* Subroutine */ int gliget_(char *, integer *, ftnlen);
+ extern logical lchreq_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int gllget_(char *, logical *, ftnlen), prcnam_(
+ integer *, char *, ftnlen), osabrt_(void);
+ static integer maxmsg, msglev;
+ extern /* Subroutine */ int prclvl_(integer *);
+ static integer lnsize;
+ extern /* Subroutine */ int mszdmp_(char *, integer *, integer *, ftnlen);
+
+ gliget_("MSGUNIT", &iunit, (ftnlen)7);
+ gliget_("MAXMSG", &maxmsg, (ftnlen)6);
+ gliget_("MSGLEV", &msglev, (ftnlen)6);
+ gliget_("NLNSIZE", &lnsize, (ftnlen)7);
+ gllget_("LLMSG", &llmsg, (ftnlen)5);
+ prclvl_(&nlev);
+ i__1 = min(nlev,1);
+ prcnam_(&i__1, cprc, (ftnlen)32);
+ s_copy(clevx, clev, (ftnlen)1, clev_len);
+ s_copy(csubx, csub, (ftnlen)32, csub_len);
+ lmsg = lenc_(cmsg, cmsg_len);
+ lprc = lenc_(cprc, (ftnlen)32);
+ lsub = lenc_(csubx, (ftnlen)32);
+ if (lchreq_(clevx, "E", (ftnlen)1, (ftnlen)1)) {
+ msgdmp_err_func(csub, cmsg, csub_len, cmsg_len);
+ }
+ if (imsg < maxmsg) {
+ if (lchreq_(clevx, "W", (ftnlen)1, (ftnlen)1) && msglev <= 1) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Warning (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** WARNING (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ } else if (lchreq_(clevx, "M", (ftnlen)1, (ftnlen)1) && msglev <= 0) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Message (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** MESSAGE (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ if (imsg == maxmsg) {
+ s_copy(cmsgx, "+++ THE FOLLOWING MESSAGES ARE SUPPRESSED.", (
+ ftnlen)200, (ftnlen)42);
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ }
+ return 0;
+ } /* msgdmp_err_replaceable */
diff -c -r -N /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp.c_orig ./msgdmp.c_orig
*** /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp.c_orig Thu Jan 1 09:00:00 1970
--- ./msgdmp.c_orig Wed Aug 1 18:41:02 2001
***************
*** 0 ****
--- 1,134 ----
+ /* msgdmp.f -- translated by f2c (version 19990503).
+ You must link the resulting object file with the libraries:
+ -lf2c -lm (in that order)
+ */
+
+ #include "libtinyf2c.h"
+
+ /* Table of constant values */
+
+ static integer c__6 = 6;
+ static integer c__4 = 4;
+
+ /* ----------------------------------------------------------------------- */
+ /* MSGDMP */
+ /* ----------------------------------------------------------------------- */
+ /* Copyright (C) 2000 GFD Dennou Club. All rights reserved. */
+ /* ----------------------------------------------------------------------- */
+ /* Subroutine */ int msgdmp_(char *clev, char *csub, char *cmsg, ftnlen
+ clev_len, ftnlen csub_len, ftnlen cmsg_len)
+ {
+ /* Initialized data */
+
+ static integer imsg = 0;
+
+ /* System generated locals */
+ address a__1[6], a__2[4];
+ integer i__1, i__2[6], i__3[4];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
+ char **, integer *, integer *, ftnlen), s_stop(char *, ftnlen);
+
+ /* Local variables */
+ extern integer lenc_(char *, ftnlen);
+ static char cprc[32];
+ static integer lprc, lmsg, nlev, lsub;
+ static logical llmsg;
+ static char clevx[1], cmsgx[200], csubx[32];
+ static integer iunit;
+ extern /* Subroutine */ int gliget_(char *, integer *, ftnlen);
+ extern logical lchreq_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int gllget_(char *, logical *, ftnlen), prcnam_(
+ integer *, char *, ftnlen), osabrt_(void);
+ static integer maxmsg, msglev;
+ extern /* Subroutine */ int prclvl_(integer *);
+ static integer lnsize;
+ extern /* Subroutine */ int mszdmp_(char *, integer *, integer *, ftnlen);
+
+ gliget_("MSGUNIT", &iunit, (ftnlen)7);
+ gliget_("MAXMSG", &maxmsg, (ftnlen)6);
+ gliget_("MSGLEV", &msglev, (ftnlen)6);
+ gliget_("NLNSIZE", &lnsize, (ftnlen)7);
+ gllget_("LLMSG", &llmsg, (ftnlen)5);
+ prclvl_(&nlev);
+ i__1 = min(nlev,1);
+ prcnam_(&i__1, cprc, (ftnlen)32);
+ s_copy(clevx, clev, (ftnlen)1, clev_len);
+ s_copy(csubx, csub, (ftnlen)32, csub_len);
+ lmsg = lenc_(cmsg, cmsg_len);
+ lprc = lenc_(cprc, (ftnlen)32);
+ lsub = lenc_(csubx, (ftnlen)32);
+ if (lchreq_(clevx, "E", (ftnlen)1, (ftnlen)1)) {
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "*** Error (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "***** ERROR (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ osabrt_();
+ s_stop("", (ftnlen)0);
+ }
+ if (imsg < maxmsg) {
+ if (lchreq_(clevx, "W", (ftnlen)1, (ftnlen)1) && msglev <= 1) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Warning (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** WARNING (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ } else if (lchreq_(clevx, "M", (ftnlen)1, (ftnlen)1) && msglev <= 0) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Message (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** MESSAGE (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ if (imsg == maxmsg) {
+ s_copy(cmsgx, "+++ THE FOLLOWING MESSAGES ARE SUPPRESSED.", (
+ ftnlen)200, (ftnlen)42);
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ }
+ return 0;
+ } /* msgdmp_ */
+
diff -c -r -N /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp_modify.csh ./msgdmp_modify.csh
*** /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp_modify.csh Thu Jan 1 09:00:00 1970
--- ./msgdmp_modify.csh Fri Nov 30 20:35:45 2001
***************
*** 0 ****
--- 1,159 ----
+ #! /bin/tcsh -f
+
+ if ( -f msgdmp.c ) then
+ if ( ! -f msgdmp.c_orig ) then
+ mv msgdmp.c msgdmp.c_orig
+ else
+ rm msgdmp.c
+ endif
+ endif
+
+ ## replace "msgdmp_" with "msgdmp_dclorig" and "ftnlen" with "int"
+ ## is its arguments (to make tinyf2h.h unnecessary -- see the protpe
+ ## definition of msgdmp_func):
+ perl -ne 'if (/int +msgdmp_/) {s/msgdmp_/msgdmp_dclorig/;s/ftnlen/int/g;print;$h=1 if ( !(/\)$/) );} elsif ($h) {$h=0 if (/\)$/) ; s/ftnlen/int/g; print;} else {print;}' msgdmp.c_orig > msgdmp.c
+
+ cat >> msgdmp.c <<'EOF'
+ /* ----------------------------------------------------
+ * switchable MSGDMP by T. Horinouchi 2001/11/30
+ *
+ * function msgdmp_ in the following is to be used in place of
+ * the original msgdmp_, which is renamed as msgdmp_dclorig above.
+ * the new msgdmp_ calls msgdmp_func whose default value is
+ * msgdmp_dclorig. Thus, the default behavior the msgdmp_ is the same
+ * as before. However, msgdmp_func can be replaced by using
+ * set_msgdmp_func. Also, only the behaviour on error can be modified
+ * with set_mgsdmp_err.
+ * ---------------------------------------------------- */
+
+ static int (*msgdmp_func)(char *clev, char *csub, char *cmsg,
+ int clev_len, int csub_len, int cmsg_len)
+ = msgdmp_dclorig ; /* <-- default function */
+
+ static int (*msgdmp_err_func)(char *csub, char *cmsg,
+ int csub_len, int cmsg_len); /* no default */
+
+ static int msgdmp_err_replaceable (char *, char *, char *, int, int, int);
+ /* ^ defined below */
+
+ int set_msgdmp_func( int (*f)(char *clev, char *csub, char *cmsg,
+ int clev_len, int csub_len, int cmsg_len) )
+ {
+ msgdmp_func = f;
+ }
+
+ int set_msgdmp_err_func( int (*f)(char *csub, char *cmsg,
+ int csub_len, int cmsg_len) )
+ {
+ msgdmp_err_func = f;
+ msgdmp_func = msgdmp_err_replaceable;
+ }
+
+ int msgdmp_(char *clev, char *csub, char *cmsg, ftnlen
+ clev_len, ftnlen csub_len, ftnlen cmsg_len)
+ {
+ return( (*msgdmp_func)(clev, csub, cmsg,
+ clev_len, csub_len, cmsg_len) );
+ }
+
+ static int msgdmp_err_replaceable(char *clev, char *csub, char *cmsg, int
+ clev_len, int csub_len, int cmsg_len)
+ /* msgdmp_err_replaceable: by T Horinouchi 2001/11/30
+ same as msgdmp_dclorig except that msgdmp_err_func (to be set
+ by set_msgdmp_err_func) is called on error */
+ {
+ /* Initialized data */
+
+ static integer imsg = 0;
+
+ /* System generated locals */
+ address a__1[6], a__2[4];
+ integer i__1, i__2[6], i__3[4];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
+ char **, integer *, integer *, ftnlen), s_stop(char *, ftnlen);
+
+ /* Local variables */
+ extern integer lenc_(char *, ftnlen);
+ static char cprc[32];
+ static integer lprc, lmsg, nlev, lsub;
+ static logical llmsg;
+ static char clevx[1], cmsgx[200], csubx[32];
+ static integer iunit;
+ extern /* Subroutine */ int gliget_(char *, integer *, ftnlen);
+ extern logical lchreq_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int gllget_(char *, logical *, ftnlen), prcnam_(
+ integer *, char *, ftnlen), osabrt_(void);
+ static integer maxmsg, msglev;
+ extern /* Subroutine */ int prclvl_(integer *);
+ static integer lnsize;
+ extern /* Subroutine */ int mszdmp_(char *, integer *, integer *, ftnlen);
+
+ gliget_("MSGUNIT", &iunit, (ftnlen)7);
+ gliget_("MAXMSG", &maxmsg, (ftnlen)6);
+ gliget_("MSGLEV", &msglev, (ftnlen)6);
+ gliget_("NLNSIZE", &lnsize, (ftnlen)7);
+ gllget_("LLMSG", &llmsg, (ftnlen)5);
+ prclvl_(&nlev);
+ i__1 = min(nlev,1);
+ prcnam_(&i__1, cprc, (ftnlen)32);
+ s_copy(clevx, clev, (ftnlen)1, clev_len);
+ s_copy(csubx, csub, (ftnlen)32, csub_len);
+ lmsg = lenc_(cmsg, cmsg_len);
+ lprc = lenc_(cprc, (ftnlen)32);
+ lsub = lenc_(csubx, (ftnlen)32);
+ if (lchreq_(clevx, "E", (ftnlen)1, (ftnlen)1)) {
+ msgdmp_err_func(csub, cmsg, csub_len, cmsg_len);
+ }
+ if (imsg < maxmsg) {
+ if (lchreq_(clevx, "W", (ftnlen)1, (ftnlen)1) && msglev <= 1) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Warning (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** WARNING (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ } else if (lchreq_(clevx, "M", (ftnlen)1, (ftnlen)1) && msglev <= 0) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Message (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** MESSAGE (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ if (imsg == maxmsg) {
+ s_copy(cmsgx, "+++ THE FOLLOWING MESSAGES ARE SUPPRESSED.", (
+ ftnlen)200, (ftnlen)42);
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ }
+ return 0;
+ } /* msgdmp_err_replaceable */
+ 'EOF'
syslib.tar.gz