home *** CD-ROM | disk | FTP | other *** search
/ ftp.ncsa.uiuc.edu / ftp.ncsa.uiuc.edu.zip / ftp.ncsa.uiuc.edu / DataScope / misc / dscall.c < prev    next >
C/C++ Source or Header  |  2017-03-03  |  20KB  |  1,067 lines
  1. /**************************************************************************/
  2. /*  NCSA DataScope
  3. *   An experiment with real numbers.
  4. *   by Tim Krauskopf
  5. *   
  6. *   National Center for Supercomputing Applications
  7. *   University of Illinois at Urbana-Champaign
  8. *   605 E. Springfield Ave.
  9. *   Champaign, IL  61820
  10. *
  11. *   email:          softdev@ncsa.uiuc.edu
  12. *   bug reports:    bugs@ncsa.uiuc.edu
  13. *   server:         ftp.ncsa.uiuc.edu  (128.174.20.50)
  14. *
  15. *   NCSA DataScope is in the public domain.  See the manual for a complete
  16. *   permissions statement.  We ask that the following message be included
  17. *   in all derivative works:
  18. *   Portions developed at the National Center for Supercomputing Applications
  19. *   University of Illinois at Urbana-Champaign.
  20. *
  21. *   version                      comments
  22. *   -----------                -------------
  23. *   1.0 TKK  December 1988
  24. *   1.1 TKK  May 1989       -- new polar, computations, interpolation
  25. *   1.2 TKK  January 1990   -- networking additions
  26. */
  27. /*
  28. *
  29. *  dscall.c
  30. *  
  31. *  Code to use Berkeley style sockets to connect to DataScope 1.2 on
  32. *  a Macintosh.  Includes complete source for DS_SEND for FORTRAN and C
  33. *  written for UNIX and UNICOS systems.
  34. *
  35. *  To compile and link on UNICOS, using your code in myprog.c:
  36. *
  37. *  cc -DUNICOS dscall.c
  38. *  cc myprog.c dscall.o -lnet
  39. *
  40. *  On Sun UNIX, you don't need the -lnet and use DSUN instead of DUNICOS.
  41. *  For more information see the documentation for NCSA DataScope 1.2.
  42. *
  43. *
  44. *  UNSUPPORTED:
  45. *  HyperCard server.
  46. *  This server sits on a unix machine with Berkeley sockets and waits 
  47. *  for a hypercard client which is acting as a front-end.  The alternate
  48. *  version can be used with rexecd for socket-less connection from HC
  49. *  to the Mac.  These are unsupported and should be used as examples for
  50. *  original work only.
  51. *  
  52. *  October, 1989
  53. */
  54.  
  55.  
  56.  
  57. #include <stdio.h>
  58.  
  59. #ifdef UNICOS
  60. #include <fortran.h>
  61.  
  62. #define SOCKETS
  63. #define INTOFF 4        /* distance from beginning of int to 32 bit half */
  64. #define FLOFF 4            /* offset for floating point length diff */
  65. #define FLEN 8            /* floating point number length, for readability */
  66.  
  67. #endif
  68.  
  69.  
  70. #ifdef SUN
  71. #define SOCKETS
  72. #define INTOFF 0
  73. #define FLOFF 0
  74. #define FLEN 4
  75.  
  76. #include <sgtty.h>
  77. #endif SUN
  78.  
  79. #ifdef SOCKETS
  80.  
  81. #include <sys/types.h>
  82. #include <sys/socket.h>
  83. #include <sys/time.h>
  84. #include <netdb.h>
  85. #include <netinet/in.h>
  86. #include <sys/ioctl.h>
  87.  
  88. #endif
  89.  
  90. int 
  91.     sendport=7799,
  92.     slport=7888;
  93.  
  94. #ifdef SOCKETS 
  95. struct sockaddr_in myaddr,hisaddr;
  96. struct hostent *me,*him;
  97. char myname[32],hisname[32];
  98. int sock;
  99. #endif
  100.  
  101. char 
  102.     *malloc(),
  103.     *xspace,
  104.     *yspace,            /* storage for scale info */
  105.     *slspace,            /* intermediate storage */
  106.     *rspace;
  107.  
  108.  
  109. /**********************************************************************/
  110. /*  fullread
  111. *   read a full segment from the network.
  112. *   returns 0 for successful read, -1 for error 
  113. */
  114. fullread(skt,whereread,toread)
  115.     int skt,toread;
  116.     char *whereread;
  117. {
  118.     int cnt;
  119.  
  120.     while (toread > 0) {            /* count of remaining bytes to read */
  121.  
  122.         cnt = read(skt,whereread,toread);        /* read a chunk */
  123.         if (cnt < 0)                /* connection broken */
  124.             return(-1);
  125.  
  126.         toread -= cnt;                /* adjust counters for what was read */
  127.         whereread += cnt;
  128.     }
  129.  
  130.     return(0);
  131. }
  132.  
  133.  
  134. /**********************************************************************/
  135. /*  fullwrite
  136. *   write a full segment to the network.
  137. *   returns 0 for successful write, -1 for error
  138. */
  139. fullwrite(skt,wherewrite,towrite)
  140.     int skt,towrite;
  141.     char *wherewrite;
  142. {
  143.     int cnt;
  144.  
  145.     while (towrite > 0) {            /* count of remaining bytes to read */
  146.  
  147.         cnt = write(skt,wherewrite,towrite);       /* write a chunk */
  148.         if (cnt < 0)                /* connection broken */
  149.             return(-1);
  150.  
  151.         towrite -= cnt;              /* adjust counters for what was written */
  152.         wherewrite += cnt;
  153.     }
  154.  
  155.     return(0);
  156. }
  157.  
  158. /**********************************************************************/
  159. /* readto13
  160. *  read from the stream until reaching a NUL
  161. */
  162. readto13(skt,p)
  163.     int skt;
  164.     char *p;
  165.     {
  166.     char cc;
  167.     int ret;
  168.  
  169.     do {
  170.         if (0 >= (ret = read(skt,&cc,1)))
  171.             return(-1);
  172.         *p++ = cc;
  173.     } while (ret && cc != 13);
  174.  
  175.     *p++ = '\0';
  176.  
  177.     return(0);
  178. }
  179.  
  180. /**********************************************************************/
  181. /* readtonul
  182. *  read from the stream until reaching a NUL
  183. */
  184. readtonul(skt,p)
  185.     int skt;
  186.     char *p;
  187.     {
  188.     char cc;
  189.     int ret;
  190.  
  191.     do {
  192.         if (0 >= (ret = read(skt,&cc,1)))
  193.             return(-1);
  194.         *p++ = cc;
  195.     } while (ret && cc);
  196.  
  197.     return(0);
  198. }
  199.  
  200. /**********************************************************************/
  201.  
  202.  
  203. #ifdef SOCKETS
  204. /***************************************************************************/
  205. /*  commclose
  206. *  close the communications connection
  207. */
  208. commclose(skt)
  209.     int skt;
  210.     {
  211.     return(close(skt));
  212.  
  213. }
  214.  
  215. /***************************************************************************/
  216. /*  comminit
  217. *  Start communications with another host.  Goes looking for a server who
  218. *  is waiting on the port number.
  219. *  Returns an integer which will identify the connection.
  220. *  Returns -1 on error.
  221. */
  222. comminit(towho,slport)
  223.     char *towho;
  224.     int slport;
  225.     {
  226.     int a,b,c,d;
  227.     unsigned char *p;
  228.  
  229.     bzero( (char *)&hisaddr, sizeof(hisaddr));
  230.  
  231.     hisaddr.sin_family = AF_INET;
  232.     hisaddr.sin_port = htons(slport);
  233.  
  234.     if (4 == sscanf(towho,"%d.%d.%d.%d",&a,&b,&c,&d)) {
  235.         p = (unsigned char *)&hisaddr.sin_addr;
  236.         *p++ = a;
  237.         *p++ = b;
  238.         *p++ = c;
  239.         *p = d;
  240.     }
  241.     else if (NULL == (him = gethostbyname(towho))) {
  242.         perror("*** His host name");
  243.         return(-1);
  244.     }
  245.     else
  246.         /* copy in my host address */
  247.         bcopy(him->h_addr, (char *)&hisaddr.sin_addr, him->h_length);
  248.  
  249. /*
  250. *  Create the socket and bind it
  251. */
  252.     if (0 > (sock = socket(AF_INET, SOCK_STREAM, 0))) {
  253.         perror("*** Making socket");
  254.         return(-1);
  255.     }
  256.  
  257.     if (0 > connect(sock, &hisaddr, sizeof(hisaddr))) {
  258.         perror("*** Connect");
  259.         return(-1);
  260.     }
  261.  
  262.     puts("=== Connect.");
  263.  
  264.     return(sock);
  265.     
  266. }
  267.  
  268. /**************************************************************************/
  269. /*  commlisten
  270. *   Wait for a connection attempt from the client
  271. */
  272. commlisten(theport)
  273.     int theport;
  274.     {
  275.     int ret,len;
  276.  
  277. /*
  278. *  Who am I? 
  279. */
  280.     gethostname(myname,32);
  281.  
  282.     if (NULL == (me = gethostbyname(myname))) {
  283.         perror("*** My host name");
  284.         return(-1);
  285.     }
  286.  
  287.     bzero( (char *)&myaddr, sizeof(myaddr));
  288.     myaddr.sin_family = AF_INET;
  289.     myaddr.sin_port = htons(theport);
  290.     bcopy(me->h_addr, (char *)&myaddr.sin_addr, me->h_length);
  291. /*
  292. *  Create the socket and bind it
  293. */
  294.     if (0 > (sock = socket(AF_INET, SOCK_STREAM, 0))) {
  295.         perror("*** Making socket");
  296.         return(-1);
  297.     }
  298.  
  299.     if (0 > bind(sock, &myaddr, sizeof(myaddr))) {
  300.         perror("*** Binding socket");
  301.         return(-1);
  302.     }
  303.  
  304.     listen(sock,2);
  305.  
  306.     puts("=== Listening . . .");
  307.  
  308.     return(0);
  309. }
  310.  
  311. commaccept(sock)
  312. {
  313.     int ret,len;
  314. /*
  315. *  wait for connection
  316. */
  317.     len = 32;
  318.     if ( 0 > (ret = accept(sock, hisname, &len))) {
  319.         perror("*** Accept");
  320.         return(-1);
  321.     }
  322.  
  323.     puts("=== Connection.");
  324.  
  325.     return(ret);
  326.  
  327. }
  328.  
  329. #endif
  330.  
  331. #ifdef SUN
  332. flconvert()
  333.     {
  334.  
  335. }
  336.  
  337. flbackconvert()
  338.     {
  339.  
  340. }
  341. #endif
  342.  
  343.  
  344. #ifdef UNICOS
  345.  
  346.  
  347. /*
  348. *  Convert floats from 4 bytes IEEE-32 to/from Cray-64 8 bytes.
  349. *  Also responsible for unpacking and packing the 4 byte numbers.
  350. *
  351. *  These routines are not responsible for space allocation whatsoever.
  352. *  They are assured that the space given is 8-bytes per float for as
  353. *  many floats are given.  When extra space is generated in backconvert,
  354. *  it lets the calling routine still take care of it.
  355. */
  356.  
  357.  
  358. #define MINEXP    0x3f81000000000000  /* min valid Cray masked exponent */
  359. #define MAXEXP    0x407e000000000000  /* max valid Cray masked exponent */
  360.  
  361. #define C_FMASK   0x00007fffff000000  /* Cray fraction mask (1st 23 bits)*/
  362. #define C_EMASK   0x7fff000000000000  /* Cray exponent mask */
  363. #define C_SMASK   0x8000000000000000  /* Cray sign mask */
  364. #define C_IMPLICIT 0x0000800000000000 /* Cray implicit bit */
  365.  
  366. #define I_FMASK   0x007fffff          /* IEEE fraction mask */
  367. #define I_EMASK   0x7f800000          /* IEEE exponent mask */
  368. #define I_SMASK   0x80000000          /* IEEE sign mask     */
  369.  
  370. #define IEEE_BIAS 0177
  371. #define CRAY_BIAS 040000
  372.  
  373. static long C2I_diff;
  374. static long I2C_diff;
  375.  
  376.  
  377.  
  378. flbackconvert(farr,nf)
  379.     char *farr;
  380.     int nf;
  381.     {
  382.     int i;
  383.     long tmp,newnum;
  384.     char *to,*p;
  385.  
  386.     to = farr;            /* counts 4 byte IEEE numbers */
  387.  
  388.     for (i=0; i< nf; i++) {
  389.         bcopy(farr, &newnum, 8);
  390.         farr += 8;
  391.  
  392.         if (!newnum)
  393.             tmp = 0;
  394.         else {
  395.              
  396.             tmp = (C_EMASK & newnum);
  397.             if (tmp < MINEXP) {
  398.                 newnum = 1e-30;            /* should be -INF */
  399.                 tmp = (C_EMASK & newnum);
  400.             }
  401.             else if (tmp > MAXEXP) {
  402.                 newnum = 1e30;            /* should be +INF */
  403.                 tmp = (C_EMASK & newnum);
  404.             }
  405.  
  406.             C2I_diff = (IEEE_BIAS - CRAY_BIAS - 1) << 48;
  407.             tmp = (( tmp + C2I_diff ) << 7)
  408.                 | ( (newnum & C_FMASK) << 8 )
  409.                 | ( (newnum & C_SMASK));
  410.  
  411.         }
  412.  
  413.         bcopy(&tmp,to,4);
  414.         to += 4;
  415.  
  416.     }
  417.  
  418. }
  419.  
  420.  
  421.  
  422. /* Conversion from IEEE floating point format to Cray format */
  423.  
  424. flconvert(farr,nf)
  425.     char *farr;
  426.     int nf;
  427.     {
  428.     int i;
  429.     long tmp,targ;
  430.     char *from,*to;
  431.  
  432.     from = farr + 4*(nf-1);        /* end of IEEE array, work backwards */
  433.     to = farr + 8*(nf-1);        /* end of Cray array, work backwards */
  434.  
  435.     for (i=0; i<nf; i++) {        /* for each float */
  436.         tmp = 0;
  437.         bcopy(from, FLOFF+(char *)&tmp, 4); 
  438.         from -= 4;
  439.  
  440.         if (!(targ = (tmp & I_EMASK))) {
  441.             targ = 0;
  442.         }
  443.         else {
  444.             I2C_diff = (CRAY_BIAS - IEEE_BIAS + 1) << 23;
  445.             targ += I2C_diff;
  446.             targ = (targ<< 25)  | ( (tmp & I_FMASK) << 24)
  447.                | ( (tmp & I_SMASK) << 32) | C_IMPLICIT;
  448.  
  449.         }
  450.         bcopy(&targ, to, 8);
  451.         to -= 8;                /* room for next one */
  452.  
  453.     }
  454.  
  455. }
  456.  
  457.  
  458.  
  459. #endif
  460.  
  461. /************************************************************************/
  462. /* DSDELIVER
  463. *  uses a FORTRAN calling interface and delivers a dataset to the
  464. *  new DataScope which receives datasets from the network.
  465. *
  466. *  The var name must be declared as CHARACTER*80
  467. *
  468. */
  469.  
  470. static int sendcd;
  471.  
  472. #ifdef UNICOS
  473. DS_SEND1(name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals)
  474. #else
  475. ds_send1_(name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals)
  476. #endif
  477.     char *name,*flags;
  478.     int *nrowsp,*ncolsp;
  479.     float *maxp,*minp,*vals,*rows,*cols;
  480. {
  481.  
  482.     int i,xd,yd;
  483.     float max,min;
  484.     char newname[100],newflags[100];
  485.  
  486. /*
  487. *  Character string conversions for UNICOS
  488. *
  489. *  Currently, these are macros which return the converted pointer
  490. *  from the original.
  491. */
  492. #ifdef UNICOS
  493.  
  494.     xd = _fcdlen(name);
  495.     name = _fcdtocp(name);
  496.     for (i=0; i<xd; i++)            /* copy it over */
  497.         newname[i] = *name++;
  498.     newname[i] = 0;
  499.     name = newname;
  500.  
  501.     xd = _fcdlen(flags);
  502.     flags = _fcdtocp(flags);
  503.     for (i=0; i<xd; i++)            /* copy it over */
  504.         newflags[i] = *flags++;
  505.     newflags[i] = 0;
  506.     flags = newflags;
  507.  
  508. #endif
  509.  
  510. /*
  511. *  do the character conversions from FORTRAN to C for non-UNICOS
  512. *  This trimming operation is required for converted UNICOS strings also.
  513. */
  514.     for (i=0; i<80; i++)
  515.         if (!name[i])
  516.             break;
  517.     i--;
  518.  
  519.     for ( /* i is already set */ ; name[i] == ' '; i--)
  520.         ;
  521.  
  522.     name[++i] = '\0';        /* trim FORTRAN string */
  523.  
  524.     for (i=0; flags[i] > ' '; i++)
  525.         ;
  526.  
  527.     flags[i] = '\0';
  528.  
  529. /*
  530. *  call the C version to actually send the formatted data.
  531. */
  532.     return( 
  533.         ds_send1(name,flags,*maxp,*minp,*nrowsp,*ncolsp,rows,cols,vals) );
  534.  
  535. }
  536.  
  537. /************************************************************************/
  538. /* DS_SEND
  539. *  uses a FORTRAN calling interface and delivers a dataset to the
  540. *  new DataScope which receives datasets from the network.
  541. *
  542. *
  543. */
  544.  
  545. #ifdef UNICOS
  546. DS_SEND(host,name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals)
  547. #else
  548. ds_send_(host,name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals)
  549. #endif
  550.     char *name,*flags,*host;
  551.     int *nrowsp,*ncolsp;
  552.     float *maxp,*minp,*vals,*rows,*cols;
  553. {
  554.  
  555. #ifdef UNICOS
  556.     DS_OPEN(host);
  557.     
  558.     DS_SEND1(name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals);
  559.     
  560.     DS_CLOSE();
  561. #else
  562.     ds_open_(host);
  563.     
  564.     ds_send1_(name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals);
  565.     
  566.     ds_close_();
  567.  
  568. #endif
  569. }
  570.  
  571. /************************************************************************/
  572. /* Open and close for DS_SND1
  573. *
  574. */
  575.  
  576. #ifdef UNICOS
  577. DS_OPEN(host)
  578. #else
  579. ds_open_(host)
  580. #endif
  581.     char *host;
  582. {
  583.     int i,xd;
  584.     char newhost[100];
  585. /*
  586. *  Character string conversions for UNICOS
  587. *
  588. *  Currently, these are macros which return the converted pointer
  589. *  from the original.
  590. */
  591. #ifdef UNICOS
  592.  
  593.     xd = _fcdlen(host);
  594.     host = _fcdtocp(host);
  595.     for (i=0; i<xd; i++)            /* copy it over */
  596.         newhost[i] = *host++;
  597.     newhost[i] = 0;
  598.     host = newhost;
  599.  
  600. #endif
  601.  
  602.     for (i=0; host[i] > ' '; i++)        /* trim hostname string */
  603.         ;
  604.  
  605.     host[i] = '\0';
  606.  
  607.  
  608.     
  609.     if (0 > (sendcd = comminit(host,sendport))) {
  610.         puts("*** Cannot open network connection ");
  611.         return(-1);
  612.     }
  613.  
  614.     return(0);
  615.  
  616. }
  617.  
  618. #ifdef UNICOS
  619. DS_CLOSE()
  620. #else
  621. ds_close_()
  622. #endif
  623. {
  624.     commclose(sendcd);
  625.  
  626. }
  627.  
  628. /************************************************************************/
  629. /*  C versions of ds_send, etc.
  630. *
  631. *
  632. */
  633. ds_open(host)
  634.     char *host;
  635. {
  636.     
  637.     if (0 > (sendcd = comminit(host,sendport))) {
  638.         puts("*** Cannot open network connection ");
  639.         return(-1);
  640.     }
  641.  
  642.     return(0);
  643. }
  644.  
  645. ds_close()
  646. {
  647.     commclose(sendcd);
  648. }
  649.  
  650. ds_send(host,name,flags,max,min,nrows,ncols,rows,cols,vals)
  651.     char *name,*flags,*host;
  652.     int nrows,ncols;
  653.     float max,min,*vals,*rows,*cols;
  654. {
  655.  
  656.     ds_open(host);
  657.     
  658.     ds_send1(name,flags,max,min,nrows,ncols,rows,cols,vals);
  659.     
  660.     ds_close();
  661. }
  662.  
  663. /************************************************************************/
  664. /*  ds_send1
  665. *
  666. *   This routine implements the actual protocol which sends the data
  667. *   to the Macintosh.
  668. *   The protocol is only documented in this source code.
  669. *   The first four characters sent over the line indicate that the rest
  670. *   of the data will be in fixed DataScope format.
  671. */
  672.  
  673. ds_send1(name,flags,max,min,nrows,ncols,rows,cols,vals)
  674.     char *name,*flags;
  675.     int nrows,ncols;
  676.     float max,min,*vals,*rows,*cols;
  677. {
  678.  
  679.     int i,xd,yd;
  680.  
  681. /*
  682. *  copy the data so that we don't destroy it by converting it to IEEE format.
  683. */
  684.     yd = nrows;
  685.     xd = ncols;
  686.  
  687.     if (NULL == (slspace = malloc(xd*yd*sizeof(float) + 1000))) {
  688.         perror("*** Memory alloc");
  689.         return(1);
  690.     }
  691.     bcopy(vals,slspace,xd*yd*sizeof(float));
  692.  
  693.     if (NULL == (xspace = malloc(xd*sizeof(float) + 1000))) {
  694.         perror("*** Memory alloc");
  695.         return(1);
  696.     }
  697.     bcopy(cols,xspace,xd*sizeof(float));
  698.  
  699.     if (NULL == (yspace = malloc(yd*sizeof(float) + 1000))) {
  700.         perror("*** Memory alloc");
  701.         return(1);
  702.     }
  703.     bcopy(rows,yspace,yd*sizeof(float));
  704.  
  705. /*
  706. *  If on a foreign architecture from DataScope, convert the
  707. *  floating point and integers to IEEE and Motorola formats.
  708. *
  709. *  Then send them to DataScope in order.
  710. *
  711. *  The first four characters are a tag to mark what follows.
  712. */
  713.     fullwrite(sendcd,"DSa1",4);
  714.     fullwrite(sendcd,name,strlen(name)+1);            /* nul-terminated var name */
  715.     fullwrite(sendcd,flags,strlen(flags)+1);        /* flags field */
  716.  
  717.     fullwrite(sendcd,INTOFF + (char *)&yd,4);
  718.     fullwrite(sendcd,INTOFF + (char *)&xd,4);
  719.     flbackconvert(&max,1);
  720.     flbackconvert(&min,1);
  721.     fullwrite(sendcd,&max,4);
  722.     fullwrite(sendcd,&min,4);
  723.  
  724.     flbackconvert(yspace,yd);
  725.     fullwrite(sendcd,yspace,yd*4);
  726.     
  727.     flbackconvert(xspace,xd);
  728.     fullwrite(sendcd,xspace,xd*4);
  729.     
  730.     flbackconvert(slspace,xd*yd);
  731.     fullwrite(sendcd,slspace,xd*yd*4);
  732.  
  733.     free(slspace);
  734.     free(xspace);
  735.     free(yspace);
  736.  
  737.     return(0);
  738. }
  739.  
  740.  
  741. #ifdef HC_SOCKETS
  742. /************************************************************************/
  743. /* Hypercard interface callable from FORTRAN
  744. *  uses a FORTRAN calling interface and checks for HyperCard generated
  745. *  input on the connection stream.
  746. *
  747. *
  748. */
  749.  
  750. static int cd;
  751.  
  752. #ifdef UNICOS
  753. HC_INIT(port)
  754. #else
  755. hc_init_(port)
  756. #endif
  757. int *port;
  758. {
  759.  
  760.     if (0 > commlisten(*port)) {
  761.         puts("*** Cannot open network connection ");
  762.         return(-1);
  763.     }
  764.     
  765.     return(0);
  766. }
  767.  
  768. #ifdef UNICOS
  769. HC_DONE()
  770. #else
  771. hc_done_()
  772. #endif
  773. {
  774.  
  775. return(commclose(cd));
  776. }
  777.  
  778. #ifdef UNICOS
  779. HC_WAIT()
  780. #else
  781. hc_wait_()
  782. #endif
  783. {
  784.     if (0 < (cd = commaccept(sock)))
  785.         return(0);
  786.     else
  787.         return(-1);
  788.         
  789. }
  790.  
  791. /*************************************************************************/
  792. /*  hc_get
  793. *  Get a string from HyperCard front-end.
  794. *  waitflag = 0 means do not wait for HC, return -1
  795. *  waitflag = 1 means wait for input from HC
  796. *
  797. */
  798. #ifdef UNICOS
  799. HC_GET(waitflag,stuff)
  800.     _fcd stuff;
  801. #else
  802. hc_get_(waitflag,stuff)
  803.     char *stuff;
  804. #endif
  805.     int *waitflag;
  806.     
  807. {
  808.     int stufflen,i;
  809.     char *mystuff;
  810.  
  811.  
  812. /*
  813. *  Character string conversions for UNICOS
  814. *
  815. *  Currently, these are macros which return the converted pointer
  816. *  from the original.
  817. */
  818. #ifdef UNICOS
  819.  
  820.     stufflen = _fcdlen(stuff);
  821.     mystuff = _fcdtocp(stuff);
  822. #else
  823.     stufflen = 256;
  824.     mystuff = stuff;
  825. #endif
  826.  
  827.  
  828.     if (!(*waitflag)) {            /* use select to check on input */
  829.         struct timeval timeout;
  830.         int mask;
  831.         
  832.         mask = 1<<cd;            /* select on socket cd */
  833.         timeout.tv_sec = 0;
  834.         timeout.tv_usec = 0;
  835.         i = select(16,&mask,0,0,&timeout);
  836.         
  837.         if (i <= 0)                /* nothing to read */
  838.             return(-1);
  839.     }    
  840. /*
  841. *  read from HyperCard
  842. */
  843.  
  844.     if (0 > readto13(cd,mystuff))
  845.         return(-2);
  846.         
  847.     for (i=strlen(mystuff)-1; i<stufflen; i++)    /* pad for FORTRAN with ' ' */
  848.         mystuff[i] = ' ';
  849.         
  850.  
  851.     return(0);
  852. }
  853.  
  854. /*************************************************************************/
  855. /*  hc_put
  856. *  Send a string to HyperCard front-end.
  857. */
  858. #ifdef UNICOS
  859. HC_PUT(stuff)
  860.     _fcd stuff;
  861. #else
  862. hc_put_(stuff)
  863.     char *stuff;
  864. #endif
  865.     
  866. {
  867.     int stufflen,i;
  868.     char *mystuff;
  869.  
  870.  
  871. /*
  872. *  Character string conversions for UNICOS
  873. *
  874. *  Currently, these are macros which return the converted pointer
  875. *  from the original.
  876. */
  877. #ifdef UNICOS
  878.  
  879.     stufflen = _fcdlen(stuff);
  880.     mystuff = _fcdtocp(stuff);
  881. #else
  882.     stufflen = 256;
  883.     mystuff = stuff;
  884. #endif
  885.  
  886. /*
  887. *  do the character conversions from FORTRAN to C for non-UNICOS
  888. *  This trimming operation is required for converted UNICOS strings also.
  889. */
  890.     for (i=0; i<stufflen; i++)
  891.         if (!mystuff[i])
  892.             break;
  893.     i--;
  894.  
  895.     for ( /* i is already set */ ; mystuff[i] == ' '; i--)
  896.         ;
  897.  
  898.     mystuff[++i] = '\0';        /* trim FORTRAN string */
  899.  
  900.  
  901.     if (0 > fullwrite(cd,mystuff,strlen(mystuff)))
  902.         return(-2);        
  903.  
  904.     return(0);
  905. }
  906.  
  907. #else
  908.  
  909. /*************************************************************************/
  910. /*  Hypercard input/output
  911. *   for a program which is exec'd from the Mac.
  912. *
  913. *   reads and writes stdin/stdout
  914. *
  915. *   All init and open/close routines are NIL
  916. */
  917.  
  918. #define HCread 0
  919. #define HCwrite 1
  920.  
  921. #ifdef UNICOS
  922. HC_INIT(port)
  923. #else
  924. hc_init_(port)
  925. #endif
  926. int *port;
  927. {
  928.     return(0);
  929. }
  930.  
  931. #ifdef UNICOS
  932. HC_DONE()
  933. #else
  934. hc_done_()
  935. #endif
  936. {
  937.     return(0);
  938. }
  939.  
  940. #ifdef UNICOS
  941. HC_WAIT()
  942. #else
  943. hc_wait_()
  944. #endif
  945. {
  946.         return(0);        
  947. }
  948.  
  949. /*************************************************************************/
  950. /*  hc_get
  951. *  Get a string from HyperCard front-end.
  952. *  waitflag = 0 means do not wait for HC, return -1
  953. *  waitflag = 1 means wait for input from HC
  954. *
  955. */
  956. #ifdef UNICOS
  957. HC_GET(waitflag,stuff)
  958.     _fcd stuff;
  959. #else
  960. hc_get_(waitflag,stuff)
  961.     char *stuff;
  962. #endif
  963.     int *waitflag;
  964.     
  965. {
  966.     int stufflen,i;
  967.     char *mystuff;
  968.  
  969.  
  970. /*
  971. *  Character string conversions for UNICOS
  972. *
  973. *  Currently, these are macros which return the converted pointer
  974. *  from the original.
  975. */
  976. #ifdef UNICOS
  977.  
  978.     stufflen = _fcdlen(stuff);
  979.     mystuff = _fcdtocp(stuff);
  980. #else
  981.     stufflen = 256;
  982.     mystuff = stuff;
  983. #endif
  984.  
  985.  
  986.     if (!(*waitflag)) {            /* use select to check on input */
  987.         struct timeval timeout;
  988.         int mask;
  989.         
  990.         mask = 1<<HCread;            /* select on socket HCread */
  991.         timeout.tv_sec = 0;
  992.         timeout.tv_usec = 0;
  993.         i = select(16,&mask,0,0,&timeout);
  994.         
  995.         if (i <= 0)                /* nothing to read */
  996.             return(-1);
  997.     }    
  998. /*
  999. *  read from HyperCard
  1000. */
  1001.  
  1002.     if (0 > readto13(HCread,mystuff))
  1003.         return(-2);
  1004.         
  1005.     for (i=strlen(mystuff)-1; i<stufflen; i++)    /* pad for FORTRAN with ' ' */
  1006.         mystuff[i] = ' ';
  1007.         
  1008.  
  1009.     return(0);
  1010. }
  1011.  
  1012. /*************************************************************************/
  1013. /*  hc_put
  1014. *  Send a string to HyperCard front-end.
  1015. */
  1016. #ifdef UNICOS
  1017. HC_PUT(stuff)
  1018.     _fcd stuff;
  1019. #else
  1020. hc_put_(stuff)
  1021.     char *stuff;
  1022. #endif
  1023.     
  1024. {
  1025.     int stufflen,i;
  1026.     char *mystuff;
  1027.  
  1028.  
  1029. /*
  1030. *  Character string conversions for UNICOS
  1031. *
  1032. *  Currently, these are macros which return the converted pointer
  1033. *  from the original.
  1034. */
  1035. #ifdef UNICOS
  1036.  
  1037.     stufflen = _fcdlen(stuff);
  1038.     mystuff = _fcdtocp(stuff);
  1039. #else
  1040.     stufflen = 256;
  1041.     mystuff = stuff;
  1042. #endif
  1043.  
  1044. /*
  1045. *  do the character conversions from FORTRAN to C for non-UNICOS
  1046. *  This trimming operation is required for converted UNICOS strings also.
  1047. */
  1048.     for (i=0; i<stufflen; i++)
  1049.         if (!mystuff[i])
  1050.             break;
  1051.     i--;
  1052.  
  1053.     for ( /* i is already set */ ; mystuff[i] == ' '; i--)
  1054.         ;
  1055.  
  1056.     mystuff[++i] = '\r';        /* carriage return for Mac display */
  1057.     mystuff[++i] = '\0';        /* trim FORTRAN string */
  1058.  
  1059.  
  1060.     if (0 > fullwrite(HCwrite,mystuff,strlen(mystuff)))
  1061.         return(-2);    
  1062.  
  1063.     return(0);
  1064. }
  1065.  
  1066. #endif
  1067.