- Rearranged directory structure for forking out ANSTO

- Refactored site specific stuff into a site module
- PSI specific stuff is now in the PSI directory.
- The old version has been tagged with pre-ansto

tecs/myc_err.c

@@ -0,0 +1,136 @@
+#include <assert.h>
+#include <string.h>
+#include <stdlib.h>
+
+#include "myc_fortran.h"
+#include "myc_str.h"
+#include "myc_err.h"
+
+#define SLEN 64
+#define MLEN 64
+
+static char *txt[SLEN];
+static int sp=0;
+static int stack_empty=1;
+
+int ErrCode;
+char *ErrMessage=NULL;
+void (*outrtn)(void *, char *)=NULL;
+void *outarg;
+
+void ErrTxt(char *text, int systemError)
+{
+  if (systemError) {
+    sp=0; ErrCode=errno; ErrMessage=strerror(errno);
+  }
+  if (stack_empty && sp>0) {
+    sp=0;
+    stack_empty=0;
+  }
+  if (sp<SLEN) {
+    txt[sp++]=text;
+  }
+}
+
+void ErrMsg(char *msg)
+{
+  ErrCode=-1;
+  ErrMessage=msg; sp=0;
+}
+
+void ErrCod(int code)
+{
+  ErrCode=code;
+  ErrMessage=strerror(code); sp=0;
+}
+
+void ErrOutFil(void *arg, char *text) {
+  fprintf((FILE *)arg, "%s\n", text);
+}
+
+void ErrShow(char *text)
+{
+  int i, l;
+  char buf[256];
+
+  if (outrtn==NULL) {
+    outrtn=ErrOutFil;
+    outarg=stdout;
+  }
+  l=strlen(text)+strlen(ErrMessage)+6;
+  assert(l<256);
+  sprintf(buf, "--- %s: %s", text, ErrMessage);
+  for (i=0;i<sp;i++) {
+    if (txt[i][0]==':') {
+      l+=strlen(txt[i]);
+      assert(l<256);
+      strcat(buf, &(txt[i][1]));
+    } else {
+      outrtn(outarg, buf);
+      l=strlen(txt[i]);
+      assert(l<256);
+      strcpy(buf, txt[i]);
+    }
+  }
+  outrtn(outarg, buf);
+  outrtn(outarg, "");
+  stack_empty=1;
+}
+
+void ErrShort(char *msg) {
+  if (outrtn==NULL) {
+    outrtn=ErrOutFil;
+    outarg=stdout;
+  }
+  outrtn(outarg, msg);
+}
+
+void ErrSetOutRtn(void (*rtn)(void *, char *), void *arg) {
+  outrtn=rtn;
+  outarg=arg;
+}
+
+void ErrSetOutFile(FILE *arg) {
+  outrtn=ErrOutFil;
+  outarg=arg;
+}
+
+void ERR_EXIT(char *text) {
+  ErrShow(text); exit(1);
+}
+
+/* FORTRAN wrappers */
+
+#ifdef F_CHAR
+/* compile only when fortran c interface stuff is defined */
+
+void F_FUN(err_show)(F_CHAR(text), int text_len) {
+  char buf[256];
+
+  STR_TO_C(buf, text);
+  ErrShow(buf);
+}
+
+void F_FUN(err_txt)(F_CHAR(text), int text_len) {
+  char buf[256];
+
+  STR_TO_C(buf, text);
+  ErrTxt(buf,0);
+}
+
+void F_FUN(err_msg)(F_CHAR(text), int text_len) {
+  static char buf[256];
+
+  STR_TO_C(buf, text);
+  ErrMsg(buf);
+}
+
+void F_FUN(err_set_outrtn)(void (*rtn)(void *, char*), void *arg) {
+  ErrSetOutRtn(rtn, arg);
+}
+
+void F_FUN(err_short)(void) {
+  ErrShort(ErrMessage);
+}
+
+#endif