Return to unixlib.pri CVS log

Up to [gforth] / gforth / wordlibs

Supports to build up c libraries of forth words in the format used in the
prim file. Worked on linux machines.
On sun linker exits with "fatal signal 6"...

    1: alarm	u --	unixlib
    2: #include <unistd.h>
    3: alarm(u);
    4: 
    5: timeusec	-- u_usec u_sec	unixlib
    6: #include <time.h>
    7: struct timeval tv;
    8: struct timezone zone1;
    9:  gettimeofday(&tv,&zone1);
   10: u_usec=tv.tv_usec;
   11: u_sec=tv.tv_sec;
   12: 
   13: time	-- u1	unixlib
   14: u1=(long) time(NULL);
   15: 
   16: \ Serial Interface
   17: 
   18: setttyspeed	u u2 -- wior	unixlib
   19: struct termios tm;
   20: int BT[]={
   21:   0,B0,50,B50,75,B75,110,B110,134,B134,150,B150,200,B200,300,B300,
   22:   600,B600,1200,B1200,1800,B1800,2400,B2400,4800,B4800,9600,B9600,19200,B19200,38400,B38400,
   23: #ifdef B57600
   24:   57600,B57600,
   25: #endif
   26: #ifdef B115200
   27:   115200,B115200,
   28: #endif
   29: #ifdef B230400
   30:   230400,B230400,
   31: #endif
   32:   1};
   33: speed_t br;
   34: int i;
   35: i=0; br=0;
   36: while (BT[i]!=1)
   37: { if (BT[i]==u)
   38:   { br=BT[i+1];
   39:     break;
   40:   }
   41:   i=i+2;
   42: }
   43: if (BT[i]!=1)
   44: { tcgetattr(u2,&tm);
   45:   cfsetispeed(&tm, br);
   46:   cfsetospeed(&tm, br);
   47:   tcsetattr(u2,TCSANOW,&tm);
   48:   wior=0;
   49: } else
   50: { wior=-1;
   51: }
   52: 
   53: setttyraw	u -- wior	unixlib
   54: struct termios tm;
   55: tcgetattr(u,&tm);
   56: cfmakeraw(&tm);
   57: tcsetattr(u,TCSANOW,&tm);
   58: wior=0;
   59: 
   60: ttytostd	c_addr1 u1 -- wior	unixlib
   61: int i;
   62: wior=0;
   63: close(0);
   64: close(1);
   65: close(2);
   66: i=open(cstr(c_addr1,u1,0),O_RDWR|O_NOCTTY);
   67: if ((i==-1) || (i!=0))
   68: {	wior=-1;
   69: } else
   70: {	i= dup(0);
   71: 	i= dup(0);
   72: 	i=open("/dev/tty",O_RDWR);
   73: 	if (i>=0) {
   74: 	  ioctl(i,TIOCNOTTY,0);
   75: 	  (void) close(i);
   76: 	}
   77: }
   78: 
   79: uopen	c_addr u uflags umode -- w2 wior	file
   80: w2 = open(tilde_cstr(c_addr, u, 1), uflags , (mode_t) umode);
   81: if (w2 == -1) {
   82:   wior = -37;
   83: } else {
   84:   wior = 0;
   85: }
   86: 
   87: uread	c_addr u u1 -- u3 wior	new
   88: wior=0;
   89: if ((u3 = read(u1, c_addr, u))==-1) 
   90: {	if (errno==EWOULDBLOCK) u3=0;
   91: 	else wior=-37;
   92: } else
   93: { 	if (u3==0) wior=-39;
   94: }
   95: 
   96: uwrite	c_addr u u1 -- u3 wior	new
   97: wior=0;
   98: if ((u3 = write(u1, c_addr, u))==-1)
   99: {	if (errno==EAGAIN) u3=0;
  100: 	else wior=-37;
  101: }
  102: 
  103: uclose	u -- wior	new
  104: wior=0;
  105: if (close(u)) wior=-37;
  106: 
  107: nonblock	u1 -- wior	new
  108: fcntl(u1,F_SETFL,O_NONBLOCK);
  109: wior=0;
  110: 
  111: get_cconst	c_addr u -- u1 wior	new
  112: static char CONST_NAMES[][32]={
  113: "O_RDONLY",
  114: "O_WRONLY",
  115: "O_RDWR",
  116: ""};
  117: static unsigned int CONST_VALUES[]={
  118: O_RDONLY,
  119: O_WRONLY,
  120: O_RDWR}; 
  121: int i=0;
  122: int contd=1;
  123: u1=0;
  124: wior=-1;
  125: while (CONST_NAMES[i] && contd) {
  126: 	if (strcmp(CONST_NAMES[i],cstr(c_addr,u,1))==0) {
  127: 		contd=0; u1=CONST_VALUES[i]; wior=0;} ;
  128: 	i++;
  129: }
  130: 
  131: fork	-- u	new
  132: u=fork();
  133: 
  134: wait	a_addr -- u	new	I_wait
  135: u=wait((int *) a_addr);
  136: 
  137: waitpid	u a_addr u2 -- u3	new	I_waitpid
  138: u3=waitpid((pid_t) u,(int *) a_addr,u2);
  139: 
  140: execv	c_addr1 u1 c_addr2 --	new
  141: char *s1=cstr(c_addr1, u1, 0);
  142: execv(s1, (void *) c_addr2); 
  143: 
  144: errno	-- u	new
  145: u=errno;