[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[dennou-ruby:000965] msgdmp for CDCL
高橋(FIP)様、皆様：
堀之内です。
前から希望してました CDCL において msgdmp_ を取り替え可能にする
件ですが、自分でやりましたので、dcl-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 から、ちょっ
とでもそちらでアップデートしている分はありますか。もしあればそち
らで取り込んでリリースしてください（ftp領域に cp するのは dcl グ
ループじゃないと出来ないので、誰かにやって貰いましょう。塩谷さん
がいないので、多忙のところ申し訳ないけど林さんで）。取り込み方で
すが、添付の tar.gz ファイルを使えば、syslib を丸ごと置き換えれ
ばいいです。また、そちらで全くアップデートしてない場合は、ftp版
の修正はこちらで行えますが、いずれにしても、そちらにある本家への
取り込みはお願いします。さらに、私は 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