Initial commit

unix/sys_unix.c

@@ -0,0 +1,167 @@
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <termios.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <time.h>
+#include <utmp.h>
+#include "myc_tmp.h"
+#include "myc_str.h"
+#include "myc_fortran.h"
+
+void usleep_(int *usec) { usleep(*usec); }
+int F_FUN(getppid)(void) { return getppid(); }
+
+void F_FUN(sys_check_system)(F_CHAR(code) F_CLEN(code)) {
+#if defined __alpha
+  STR_TO_F(code, "TRU64");
+#elif defined __GNUC__
+  STR_TO_F(code, "GNU");
+#else
+#error unsupported machine
+#endif
+}
+
+void F_FUN(sys_fortran_interface)(int *underscores, int *descriptor) {
+  *underscores = F_UNDERSCORE;
+  *descriptor = F_DESCRIPTOR;
+}
+
+void F_FUN(sys_realpath)(F_CHAR(rpath), int *reslen,
+  F_CHAR(path) F_CLEN(rpath) F_CLEN(path)) {
+  char p[PATH_MAX], rp[PATH_MAX], *pt;
+
+  STR_TO_C(p, path);
+  pt=realpath(p, rp);
+  if (pt==NULL) str_copy(rp, p);
+  *reslen=strlen(rp);
+  STR_TO_F(rpath, rp);
+}
+
+int sys_trim(char *str, int clen) {
+  while (clen>0) {
+    clen--;
+    if (str[clen] != ' ') return clen+1;
+  }
+  return 1;
+}
+
+long F_FUN(sys_time)(void) {
+  return time(NULL);
+}
+
+void F_FUN(sys_cmd)(char *command, int clen) {
+  int l;
+  char *p;
+
+  l = sys_trim(command, clen);
+  p = malloc((unsigned) l+1); if( p == NULL ) return;
+  strncpy(p,command,l); p[l] = '\0';
+  system(p);
+  free(p);
+}
+
+void F_FUN(sys_cmd_result)(F_CHAR(command), F_CHAR(result), int *reslen F_CLEN(command) F_CLEN(result)) {
+  int l;
+  char *p;
+  FILE *fp;
+  char *buffer[PATH_MAX];
+
+  STR_TO_C(buffer, command);
+  fp = popen(buffer, "r");
+  buffer[0] = '\0';
+  if (fp != NULL) {
+    fgets(buffer, sizeof(buffer), fp);
+    pclose(fp);
+  }
+  *reslen = strlen(buffer);
+  STR_TO_F(result, buffer);
+}
+
+static struct termios atts;
+
+void F_FUN(sys_rd_tmo)(char *prompt, char *result, int *reslen, int p_len, int r_len) {
+  struct termios attr;
+  int ires, i, ntmo, chr;
+
+  ires=tcgetattr(STDIN_FILENO,&attr);
+  atts=attr; /* save term. attr. */
+  if (ires!=0) {
+    perror("error in terinq/tcgetattr ");
+    (*reslen)=0;
+    *result='\0';
+    return;
+  }
+  attr.c_lflag &= ~(ICANON) & ~(ECHO); /* canonical mode off, echo off */
+  attr.c_cc[VMIN]=0;
+  ires= tcsetattr(STDIN_FILENO,TCSANOW,&attr);
+  if (ires!=0) {perror("error in terinq/tcsetattr ");}
+
+  do { chr=fgetc(stdin); } while (chr!=EOF);
+
+  for (i=0; i<p_len; i++)
+  { fputc(prompt[i], stderr);
+  };
+
+  ires=fflush(stdin);
+  ires=fflush(stderr);
+
+  *reslen=0;
+  if (prompt[0]=='\0') { ntmo=10; }
+  else { ntmo=200; }; /* wait 2 sec. for the first char */
+  while (*reslen<r_len)
+  { chr=fgetc(stdin);
+    if (chr==EOF)
+    { while ((chr==EOF) & (ntmo>0))
+      { usleep(10000); /* wait 10 ms */
+        chr=fgetc(stdin);
+        ntmo--;
+      };
+      if (chr==EOF) break;
+      if (chr==10) {ntmo=10;} else {ntmo=100;}; /* wait 0.1 sec after LF, 1 sec else */
+    };
+    result[(*reslen)++]=(char)chr;
+    if (chr==24) {(*reslen)=0;}; /* ctrl-X purges buffer */
+  };
+  if (result[(*reslen)-1]==10) {(*reslen)--;}; /* strip trailing LF */
+
+  ires=tcsetattr(STDIN_FILENO,TCSANOW,&atts); /* restore term. attributes */
+  clearerr(stdin);
+  if (ires!=0) {
+    perror("error in terinq/tcsetattr ");
+  }
+}
+
+void F_FUN(sys_get_raw_key)(char *key, int *tmo, int k_len)
+{
+  struct termios attr;
+  int ires, ntmo, chr;
+  
+  ires=tcgetattr(STDIN_FILENO,&attr);
+  atts=attr; /* save term. attr. */
+  if (ires!=0) {perror("***\n");}
+  attr.c_lflag &= ~(ICANON) & ~(ECHO); /* canonical mode off, echo off */
+  attr.c_cc[VMIN]=0;
+  ires= tcsetattr(STDIN_FILENO,TCSANOW,&attr);
+  if (ires!=0) {perror("***\n");}
+  
+  ntmo=*tmo*100;
+  chr=fgetc(stdin);
+  if (chr==EOF) {
+    while ((chr==EOF) & (ntmo>0)) {
+      usleep(10000); /* wait 10 ms */
+      chr=fgetc(stdin);
+      ntmo--;
+    }
+  }
+  if (chr==EOF) chr=0;
+      
+  *key=chr;
+      
+  ires=tcsetattr(STDIN_FILENO,TCSANOW,&atts); /* restore term. attributes */
+  if (ires!=0) {perror("***\n");};
+} 
+