home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / C / Applications / DataScope 2.0.3 / Datafiles / Example_rmt_pgm / dscall.c next >
Encoding:
Text File  |  1994-05-04  |  19.8 KB  |  878 lines  |  [TEXT/MPS ]
  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 comp**********************/
  16. /*  commclose
  17. *  close the communications connection
  18. */
  19. commclose(skt)
  20.     int skt;
  21.     {
  22.     return(close(skt));
  23.  
  24. }
  25.  
  26. /***************************************************************************/
  27. /*  comminit
  28. *  Start communications with another host.  Goes looking for a server who
  29. *  is waiting on the port number.
  30. *  Returns an integer which will identify the connection.
  31. *  Returns -1 on error.
  32. */
  33. comminit(towho,slport)
  34.     char *towho;
  35.     int slport;
  36.     {
  37.     int a,b,c,d;
  38.     unsigned char *p;
  39.  
  40.     bzero( (char *)&hisaddr, sizeof(hisaddr));
  41.  
  42.     hisaddr.sin_family = AF_INET;
  43.     hisaddr.sin_port = htons(slport);
  44.  
  45.     if (4 == sscanf(towho,"%d.%d.%d.%d",&a,&b,&c,&d)) {
  46.         p = (unsigned char *)&hisaddr.sin_addr;
  47.         *p++ = a;
  48.         *p++ = b;
  49.         *p++ = c;
  50.         *p = d;
  51.     }
  52.     else if (NULL == (him = gethostbyname(towho))) {
  53.         perror("*** His host name");
  54.         return(-1);
  55.     }
  56.     else
  57.         /* copy in my host address */
  58.         bcopy(him->h_addr, (char *)&hisaddr.sin_addr, him->h_length);
  59.  
  60. /*
  61. *  Create the socket and bind it
  62. */
  63.     if (0 > (sock = socket(AF_INET, SOCK_STREAM, 0))) {
  64.         perror("*** Making socket");
  65.         return(-1);
  66.     }
  67.  
  68.     if (0 > connect(sock, &hisaddr, sizeof(hisaddr))) {
  69.         perror("*** Connect");
  70.         return(-1);
  71.     }
  72.  
  73.     puts("=== Connect.");
  74.  
  75.     return(sock);
  76.     
  77. }
  78.  
  79. /**************************************************************************/
  80. /*  commlisten
  81. *   Wait for a connection attempt from the client
  82. */
  83. commlisten(theport)
  84.     int theport;
  85.     {
  86.     int ret,len;
  87.  
  88. /*
  89. *  Who am I? 
  90. */
  91.     gethostname(myname,32);
  92.  
  93.     if (NULL == (me = gethostbyname(myname))) {
  94.         perror("*** My host name");
  95.         return(-1);
  96.     }
  97.  
  98.     bzero( (char *)&myaddr, sizeof(myaddr));
  99.     myaddr.sin_family = AF_INET;
  100.     myaddr.sin_port = htons(theport);
  101.     bcopy(me->h_addr, (char *)&myaddr.sin_addr, me->h_length);
  102. /*
  103. *  Create the socket and bind it
  104. */
  105.     if (0 > (sock = socket(AF_INET, SOCK_STREAM, 0))) {
  106.         perror("*** Making socket");
  107.         return(-1);
  108.     }
  109.  
  110.     if (0 > bind(sock, &myaddr, sizeof(myaddr))) {
  111.         perror("*** Binding socket");
  112.         return(-1);
  113.     }
  114.  
  115.     listen(sock,2);
  116.  
  117.     puts("=== Listening . . .");
  118.  
  119.     return(0);
  120. }
  121.  
  122. commaccept(sock)
  123. {
  124.     int ret,len;
  125. /*
  126. *  wait for connection
  127. */
  128.     len = 32;
  129.     if ( 0 > (ret = accept(sock, hisname, &len))) {
  130.         perror("*** Accept");
  131.         return(-1);
  132.     }
  133.  
  134.     puts("=== Connection.");
  135.  
  136.     return(ret);
  137.  
  138. }
  139.  
  140. #endif
  141.  
  142. #ifdef SUN
  143. flconvert()
  144.     {
  145.  
  146. }
  147.  
  148. flbackconvert()
  149.     {
  150.  
  151. }
  152. #endif
  153.  
  154.  
  155. #ifdef UNICOS
  156.  
  157.  
  158. /*
  159. *  Convert floats from 4 bytes IEEE-32 to/from Cray-64 8 bytes.
  160. *  Also responsible for unpacking and packing the 4 byte numbers.
  161. *
  162. *  These routines are not responsible for space allocation whatsoever.
  163. *  They are assured that the space given is 8-bytes per float for as
  164. *  many floats are given.  When extra space is generated in backconvert,
  165. *  it lets the calling routine still take care of it.
  166. */
  167.  
  168.  
  169. #define MINEXP    0x3f81000000000000  /* min valid Cray masked exponent */
  170. #define MAXEXP    0x407e000000000000  /* max valid Cray masked exponent */
  171.  
  172. #define C_FMASK   0x00007fffff000000  /* Cray fraction mask (1st 23 bits)*/
  173. #define C_EMASK   0x7fff000000000000  /* Cray exponent mask */
  174. #define C_SMASK   0x8000000000000000  /* Cray sign mask */
  175. #define C_IMPLICIT 0x0000800000000000 /* Cray implicit bit */
  176.  
  177. #define I_FMASK   0x007fffff          /* IEEE fraction mask */
  178. #define I_EMASK   0x7f800000          /* IEEE exponent mask */
  179. #define I_SMASK   0x80000000          /* IEEE sign mask     */
  180.  
  181. #define IEEE_BIAS 0177
  182. #define CRAY_BIAS 040000
  183.  
  184. static long C2I_diff;
  185. static long I2C_diff;
  186.  
  187.  
  188.  
  189. flbackconvert(farr,nf)
  190.     char *farr;
  191.     int nf;
  192.     {
  193.     int i;
  194.     long tmp,newnum;
  195.     char *to,*p;
  196.  
  197.     to = farr;            /* counts 4 byte IEEE numbers */
  198.  
  199.     for (i=0; i< nf; i++) {
  200.         bcopy(farr, &newnum, 8);
  201.         farr += 8;
  202.  
  203.         if (!newnum)
  204.             tmp = 0;
  205.         else {
  206.              
  207.             tmp = (C_EMASK & newnum);
  208.             if (tmp < MINEXP) {
  209.                 newnum = 1e-30;            /* should be -INF */
  210.                 tmp = (C_EMASK & newnum);
  211.             }
  212.             else if (tmp > MAXEXP) {
  213.                 newnum = 1e30;            /* should be +INF */
  214.                 tmp = (C_EMASK & newnum);
  215.             }
  216.  
  217.             C2I_diff = (IEEE_BIAS - CRAY_BIAS - 1) << 48;
  218.             tmp = (( tmp + C2I_diff ) << 7)
  219.                 | ( (newnum & C_FMASK) << 8 )
  220.                 | ( (newnum & C_SMASK));
  221.  
  222.         }
  223.  
  224.         bcopy(&tmp,to,4);
  225.         to += 4;
  226.  
  227.     }
  228.  
  229. }
  230.  
  231.  
  232.  
  233. /* Conversion from IEEE floating point format to Cray format */
  234.  
  235. flconvert(farr,nf)
  236.     char *farr;
  237.     int nf;
  238.     {
  239.     int i;
  240.     long tmp,targ;
  241.     char *from,*to;
  242.  
  243.     from = farr + 4*(nf-1);        /* end of IEEE array, work backwards */
  244.     to = farr + 8*(nf-1);        /* end of Cray array, work backwards */
  245.  
  246.     for (i=0; i<nf; i++) {        /* for each float */
  247.         tmp = 0;
  248.         bcopy(from, FLOFF+(char *)&tmp, 4); 
  249.         from -= 4;
  250.  
  251.         if (!(targ = (tmp & I_EMASK))) {
  252.             targ = 0;
  253.         }
  254.         else {
  255.             I2C_diff = (CRAY_BIAS - IEEE_BIAS + 1) << 23;
  256.             targ += I2C_diff;
  257.             targ = (targ<< 25)  | ( (tmp & I_FMASK) << 24)
  258.                | ( (tmp & I_SMASK) << 32) | C_IMPLICIT;
  259.  
  260.         }
  261.         bcopy(&targ, to, 8);
  262.         to -= 8;                /* room for next one */
  263.  
  264.     }
  265.  
  266. }
  267.  
  268.  
  269.  
  270. #endif
  271.  
  272. /************************************************************************/
  273. /* DSDELIVER
  274. *  uses a FORTRAN calling interface and delivers a dataset to the
  275. *  new DataScope which receives datasets from the network.
  276. *
  277. *  The var name must be declared as CHARACTER*80
  278. *
  279. */
  280.  
  281. static int sendcd;
  282.  
  283. #ifdef UNICOS
  284. DS_SEND1(name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals)
  285. #else
  286. ds_send1_(name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals)
  287. #endif
  288.     char *name,*flags;
  289.     int *nrowsp,*ncolsp;
  290.     float *maxp,*minp,*vals,*rows,*cols;
  291. {
  292.  
  293.     int i,xd,yd;
  294.     float max,min;
  295.     char newname[100],newflags[100];
  296.  
  297. /*
  298. *  Character string conversions for UNICOS
  299. *
  300. *  Currently, these are macros which return the converted pointer
  301. *  from the original.
  302. */
  303. #ifdef UNICOS
  304.  
  305.     xd = _fcdlen(name);
  306.     name = _fcdtocp(name);
  307.     for (i=0; i<xd; i++)            /* copy it over */
  308.         newname[i] = *name++;
  309.     newname[i] = 0;
  310.     name = newname;
  311.  
  312.     xd = _fcdlen(flags);
  313.     flags = _fcdtocp(flags);
  314.     for (i=0; i<xd; i++)            /* copy it over */
  315.         newflags[i] = *flags++;
  316.     newflags[i] = 0;
  317.     flags = newflags;
  318.  
  319. #endif
  320.  
  321. /*
  322. *  do the character conversions from FORTRAN to C for non-UNICOS
  323. *  This trimming operation is required for converted UNICOS strings also.
  324. */
  325.     for (i=0; i<80; i++)
  326.         if (!name[i])
  327.             break;
  328.     i--;
  329.  
  330.     for ( /* i is already set */ ; name[i] == ' '; i--)
  331.         ;
  332.  
  333.     name[++i] = '\0';        /* trim FORTRAN string */
  334.  
  335.     for (i=0; flags[i] > ' '; i++)
  336.         ;
  337.  
  338.     flags[i] = '\0';
  339.  
  340. /*
  341. *  call the C version to actually send the formatted data.
  342. */
  343.     return( 
  344.         ds_send1(name,flags,*maxp,*minp,*nrowsp,*ncolsp,rows,cols,vals) );
  345.  
  346. }
  347.  
  348. /************************************************************************/
  349. /* DS_SEND
  350. *  uses a FORTRAN calling interface and delivers a dataset to the
  351. *  new DataScope which receives datasets from the network.
  352. *
  353. *
  354. */
  355.  
  356. #ifdef UNICOS
  357. DS_SEND(host,name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals)
  358. #else
  359. ds_send_(host,name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals)
  360. #endif
  361.     char *name,*flags,*host;
  362.     int *nrowsp,*ncolsp;
  363.     float *maxp,*minp,*vals,*rows,*cols;
  364. {
  365.  
  366. #ifdef UNICOS
  367.     DS_OPEN(host);
  368.     
  369.     DS_SEND1(name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals);
  370.     
  371.     DS_CLOSE();
  372. #else
  373.     ds_open_(host);
  374.     
  375.     ds_send1_(name,flags,maxp,minp,nrowsp,ncolsp,rows,cols,vals);
  376.     
  377.     ds_close_();
  378.  
  379. #endif
  380. }
  381.  
  382. /************************************************************************/
  383. /* Open and close for DS_SND1
  384. *
  385. */
  386.  
  387. #ifdef UNICOS
  388. DS_OPEN(host)
  389. #else
  390. ds_open_(host)
  391. #endif
  392.     char *host;
  393. {
  394.     int i,xd;
  395.     char newhost[100];
  396. /*
  397. *  Character string conversions for UNICOS
  398. *
  399. *  Currently, these are macros which return the converted pointer
  400. *  from the original.
  401. */
  402. #ifdef UNICOS
  403.  
  404.     xd = _fcdlen(host);
  405.     host = _fcdtocp(host);
  406.     for (i=0; i<xd; i++)            /* copy it over */
  407.         newhost[i] = *host++;
  408.     newhost[i] = 0;
  409.     host = newhost;
  410.  
  411. #endif
  412.  
  413.     for (i=0; host[i] > ' '; i++)        /* trim hostname string */
  414.         ;
  415.  
  416.     host[i] = '\0';
  417.  
  418.  
  419.     
  420.     if (0 > (sendcd = comminit(host,sendport))) {
  421.         puts("*** Cannot open network connection ");
  422.         return(-1);
  423.     }
  424.  
  425.     return(0);
  426.  
  427. }
  428.  
  429. #ifdef UNICOS
  430. DS_CLOSE()
  431. #else
  432. ds_close_()
  433. #endif
  434. {
  435.     commclose(sendcd);
  436.  
  437. }
  438.  
  439. /************************************************************************/
  440. /*  C versions of ds_send, etc.
  441. *
  442. *
  443. */
  444. ds_open(host)
  445.     char *host;
  446. {
  447.     
  448.     if (0 > (sendcd = comminit(host,sendport))) {
  449.         puts("*** Cannot open network connection ");
  450.         return(-1);
  451.     }
  452.  
  453.     return(0);
  454. }
  455.  
  456. ds_close()
  457. {
  458.     commclose(sendcd);
  459. }
  460.  
  461. ds_send(host,name,flags,max,min,nrows,ncols,rows,cols,vals)
  462.     char *name,*flags,*host;
  463.     int nrows,ncols;
  464.     float max,min,*vals,*rows,*cols;
  465. {
  466.  
  467.     ds_open(host);
  468.     
  469.     ds_send1(name,flags,max,min,nrows,ncols,rows,cols,vals);
  470.     
  471.     ds_close();
  472. }
  473.  
  474. /************************************************************************/
  475. /*  ds_send1
  476. *
  477. *   This routine implements the actual protocol which sends the data
  478. *   to the Macintosh.
  479. *   The protocol is only documented in this source code.
  480. *   The first four characters sent over the line indicate that the rest
  481. *   of the data will be in fixed DataScope format.
  482. */
  483.  
  484. ds_send1(name,flags,max,min,nrows,ncols,rows,cols,vals)
  485.     char *name,*flags;
  486.     int nrows,ncols;
  487.     float max,min,*vals,*rows,*cols;
  488. {
  489.  
  490.     int i,xd,yd;
  491.  
  492. /*
  493. *  copy the data so that we don't destroy it by converting it to IEEE format.
  494. */
  495.     yd = nrows;
  496.     xd = ncols;
  497.  
  498.     if (NULL == (slspace = malloc(xd*yd*sizeof(float) + 1000))) {
  499.         perror("*** Memory alloc");
  500.         return(1);
  501.     }
  502.     bcopy(vals,slspace,xd*yd*sizeof(float));
  503.  
  504.     if (NULL == (xspace = malloc(xd*sizeof(float) + 1000))) {
  505.         perror("*** Memory alloc");
  506.         return(1);
  507.     }
  508.     bcopy(cols,xspace,xd*sizeof(float));
  509.  
  510.     if (NULL == (yspace = malloc(yd*sizeof(float) + 1000))) {
  511.         perror("*** Memory alloc");
  512.         return(1);
  513.     }
  514.     bcopy(rows,yspace,yd*sizeof(float));
  515.  
  516. /*
  517. *  If on a foreign architecture from DataScope, convert the
  518. *  floating point and integers to IEEE and Motorola formats.
  519. *
  520. *  Then send them to DataScope in order.
  521. *
  522. *  The first four characters are a tag to mark what follows.
  523. */
  524.     fullwrite(sendcd,"DSa1",4);
  525.     fullwrite(sendcd,name,strlen(name)+1);            /* nul-terminated var name */
  526.     fullwrite(sendcd,flags,strlen(flags)+1);        /* flags field */
  527.  
  528.     fullwrite(sendcd,INTOFF + (char *)&yd,4);
  529.     fullwrite(sendcd,INTOFF + (char *)&xd,4);
  530.     flbackconvert(&max,1);
  531.     flbackconvert(&min,1);
  532.     fullwrite(sendcd,&max,4);
  533.     fullwrite(sendcd,&min,4);
  534.  
  535.     flbackconvert(yspace,yd);
  536.     fullwrite(sendcd,yspace,yd*4);
  537.     
  538.     flbackconvert(xspace,xd);
  539.     fullwrite(sendcd,xspace,xd*4);
  540.     
  541.     flbackconvert(slspace,xd*yd);
  542.     fullwrite(sendcd,slspace,xd*yd*4);
  543.  
  544.     free(slspace);
  545.     free(xspace);
  546.     free(yspace);
  547.  
  548.     return(0);
  549. }
  550.  
  551.  
  552. #ifdef HC_SOCKETS
  553. /************************************************************************/
  554. /* Hypercard interface callable from FORTRAN
  555. *  uses a FORTRAN calling interface and checks for HyperCard generated
  556. *  input on the connection stream.
  557. *
  558. *
  559. */
  560.  
  561. static int cd;
  562.  
  563. #ifdef UNICOS
  564. HC_INIT(port)
  565. #else
  566. hc_init_(port)
  567. #endif
  568. int *port;
  569. {
  570.  
  571.     if (0 > commlisten(*port)) {
  572.         puts("*** Cannot open network connection ");
  573.         return(-1);
  574.     }
  575.     
  576.     return(0);
  577. }
  578.  
  579. #ifdef UNICOS
  580. HC_DONE()
  581. #else
  582. hc_done_()
  583. #endif
  584. {
  585.  
  586. return(commclose(cd));
  587. }
  588.  
  589. #ifdef UNICOS
  590. HC_WAIT()
  591. #else
  592. hc_wait_()
  593. #endif
  594. {
  595.     if (0 < (cd = commaccept(sock)))
  596.         return(0);
  597.     else
  598.         return(-1);
  599.         
  600. }
  601.  
  602. /*************************************************************************/
  603. /*  hc_get
  604. *  Get a string from HyperCard front-end.
  605. *  waitflag = 0 means do not wait for HC, return -1
  606. *  waitflag = 1 means wait for input from HC
  607. *
  608. */
  609. #ifdef UNICOS
  610. HC_GET(waitflag,stuff)
  611.     _fcd stuff;
  612. #else
  613. hc_get_(waitflag,stuff)
  614.     char *stuff;
  615. #endif
  616.     int *waitflag;
  617.     
  618. {
  619.     int stufflen,i;
  620.     char *mystuff;
  621.  
  622.  
  623. /*
  624. *  Character string conversions for UNICOS
  625. *
  626. *  Currently, these are macros which return the converted pointer
  627. *  from the original.
  628. */
  629. #ifdef UNICOS
  630.  
  631.     stufflen = _fcdlen(stuff);
  632.     mystuff = _fcdtocp(stuff);
  633. #else
  634.     stufflen = 256;
  635.     mystuff = stuff;
  636. #endif
  637.  
  638.  
  639.     if (!(*waitflag)) {            /* use select to check on input */
  640.         struct timeval timeout;
  641.         int mask;
  642.         
  643.         mask = 1<<cd;            /* select on socket cd */
  644.         timeout.tv_sec = 0;
  645.         timeout.tv_usec = 0;
  646.         i = select(16,&mask,0,0,&timeout);
  647.         
  648.         if (i <= 0)                /* nothing to read */
  649.             return(-1);
  650.     }    
  651. /*
  652. *  read from HyperCard
  653. */
  654.  
  655.     if (0 > readto13(cd,mystuff))
  656.         return(-2);
  657.         
  658.     for (i=strlen(mystuff)-1; i<stufflen; i++)    /* pad for FORTRAN with ' ' */
  659.         mystuff[i] = ' ';
  660.         
  661.  
  662.     return(0);
  663. }
  664.  
  665. /*************************************************************************/
  666. /*  hc_put
  667. *  Send a string to HyperCard front-end.
  668. */
  669. #ifdef UNICOS
  670. HC_PUT(stuff)
  671.     _fcd stuff;
  672. #else
  673. hc_put_(stuff)
  674.     char *stuff;
  675. #endif
  676.     
  677. {
  678.     int stufflen,i;
  679.     char *mystuff;
  680.  
  681.  
  682. /*
  683. *  Character string conversions for UNICOS
  684. *
  685. *  Currently, these are macros which return the converted pointer
  686. *  from the original.
  687. */
  688. #ifdef UNICOS
  689.  
  690.     stufflen = _fcdlen(stuff);
  691.     mystuff = _fcdtocp(stuff);
  692. #else
  693.     stufflen = 256;
  694.     mystuff = stuff;
  695. #endif
  696.  
  697. /*
  698. *  do the character conversions from FORTRAN to C for non-UNICOS
  699. *  This trimming operation is required for converted UNICOS strings also.
  700. */
  701.     for (i=0; i<stufflen; i++)
  702.         if (!mystuff[i])
  703.             break;
  704.     i--;
  705.  
  706.     for ( /* i is already set */ ; mystuff[i] == ' '; i--)
  707.         ;
  708.  
  709.     mystuff[++i] = '\0';        /* trim FORTRAN string */
  710.  
  711.  
  712.     if (0 > fullwrite(cd,mystuff,strlen(mystuff)))
  713.         return(-2);        
  714.  
  715.     return(0);
  716. }
  717.  
  718. #else
  719.  
  720. /*************************************************************************/
  721. /*  Hypercard input/output
  722. *   for a program which is exec'd from the Mac.
  723. *
  724. *   reads and writes stdin/stdout
  725. *
  726. *   All init and open/close routines are NIL
  727. */
  728.  
  729. #define HCread 0
  730. #define HCwrite 1
  731.  
  732. #ifdef UNICOS
  733. HC_INIT(port)
  734. #else
  735. hc_init_(port)
  736. #endif
  737. int *port;
  738. {
  739.     return(0);
  740. }
  741.  
  742. #ifdef UNICOS
  743. HC_DONE()
  744. #else
  745. hc_done_()
  746. #endif
  747. {
  748.     return(0);
  749. }
  750.  
  751. #ifdef UNICOS
  752. HC_WAIT()
  753. #else
  754. hc_wait_()
  755. #endif
  756. {
  757.         return(0);        
  758. }
  759.  
  760. /*************************************************************************/
  761. /*  hc_get
  762. *  Get a string from HyperCard front-end.
  763. *  waitflag = 0 means do not wait for HC, return -1
  764. *  waitflag = 1 means wait for input from HC
  765. *
  766. */
  767. #ifdef UNICOS
  768. HC_GET(waitflag,stuff)
  769.     _fcd stuff;
  770. #else
  771. hc_get_(waitflag,stuff)
  772.     char *stuff;
  773. #endif
  774.     int *waitflag;
  775.     
  776. {
  777.     int stufflen,i;
  778.     char *mystuff;
  779.  
  780.  
  781. /*
  782. *  Character string conversions for UNICOS
  783. *
  784. *  Currently, these are macros which return the converted pointer
  785. *  from the original.
  786. */
  787. #ifdef UNICOS
  788.  
  789.     stufflen = _fcdlen(stuff);
  790.     mystuff = _fcdtocp(stuff);
  791. #else
  792.     stufflen = 256;
  793.     mystuff = stuff;
  794. #endif
  795.  
  796.  
  797.     if (!(*waitflag)) {            /* use select to check on input */
  798.         struct timeval timeout;
  799.         int mask;
  800.         
  801.         mask = 1<<HCread;            /* select on socket HCread */
  802.         timeout.tv_sec = 0;
  803.         timeout.tv_usec = 0;
  804.         i = select(16,&mask,0,0,&timeout);
  805.         
  806.         if (i <= 0)                /* nothing to read */
  807.             return(-1);
  808.     }    
  809. /*
  810. *  read from HyperCard
  811. */
  812.  
  813.     if (0 > readto13(HCread,mystuff))
  814.         return(-2);
  815.         
  816.     for (i=strlen(mystuff)-1; i<stufflen; i++)    /* pad for FORTRAN with ' ' */
  817.         mystuff[i] = ' ';
  818.         
  819.  
  820.     return(0);
  821. }
  822.  
  823. /*************************************************************************/
  824. /*  hc_put
  825. *  Send a string to HyperCard front-end.
  826. */
  827. #ifdef UNICOS
  828. HC_PUT(stuff)
  829.     _fcd stuff;
  830. #else
  831. hc_put_(stuff)
  832.     char *stuff;
  833. #endif
  834.     
  835. {
  836.     int stufflen,i;
  837.     char *mystuff;
  838.  
  839.  
  840. /*
  841. *  Character string conversions for UNICOS
  842. *
  843. *  Currently, these are macros which return the converted pointer
  844. *  from the original.
  845. */
  846. #ifdef UNICOS
  847.  
  848.     stufflen = _fcdlen(stuff);
  849.     mystuff = _fcdtocp(stuff);
  850. #else
  851.     stufflen = 256;
  852.     mystuff = stuff;
  853. #endif
  854.  
  855. /*
  856. *  do the character conversions from FORTRAN to C for non-UNICOS
  857. *  This trimming operation is required for converted UNICOS strings also.
  858. */
  859.     for (i=0; i<stufflen; i++)
  860.         if (!mystuff[i])
  861.             break;
  862.     i--;
  863.  
  864.     for ( /* i is already set */ ; mystuff[i] == ' '; i--)
  865.         ;
  866.  
  867.     mystuff[++i] = '\r';        /* carriage return for Mac display */
  868.     mystuff[++i] = '\0';        /* trim FORTRAN string */
  869.  
  870.  
  871.     if (0 > fullwrite(HCwrite,mystuff,strlen(mystuff)))
  872.         return(-2);    
  873.  
  874.     return(0);
  875. }
  876.  
  877. #endif
  878.