wrfv2_fire/external/RSL/RSL/rsl_socket.c

   1 /***********************************************************************
   2
   3                               COPYRIGHT
   4
   5      The following is a notice of limited availability of the code and
   6      Government license and disclaimer which must be included in the
   7      prologue of the code and in all source listings of the code.
   8
   9      Copyright notice
  10        (c) 1977  University of Chicago
  11
  12      Permission is hereby granted to use, reproduce, prepare
  13      derivative works, and to redistribute to others at no charge.  If
  14      you distribute a copy or copies of the Software, or you modify a
  15      copy or copies of the Software or any portion of it, thus forming
  16      a work based on the Software and make and/or distribute copies of
  17      such work, you must meet the following conditions:
  18
  19           a) If you make a copy of the Software (modified or verbatim)
  20              it must include the copyright notice and Government
  21              license and disclaimer.
  22
  23           b) You must cause the modified Software to carry prominent
  24              notices stating that you changed specified portions of
  25              the Software.
  26
  27      This software was authored by:
  28
  29      Argonne National Laboratory
  30      J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
  31      Mathematics and Computer Science Division
  32      Argonne National Laboratory, Argonne, IL  60439
  33
  34      ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES
  35      OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT,
  36      AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A
  37      CONTRACT WITH THE DEPARTMENT OF ENERGY.
  38
  39                       GOVERNMENT LICENSE AND DISCLAIMER
  40
  41      This computer code material was prepared, in part, as an account
  42      of work sponsored by an agency of the United States Government.
  43      The Government is granted for itself and others acting on its
  44      behalf a paid-up, nonexclusive, irrevocable worldwide license in
  45      this data to reproduce, prepare derivative works, distribute
  46      copies to the public, perform publicly and display publicly, and
  47      to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT
  48      NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF
  49      THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR
  50      ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY,
  51      COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS,
  52      PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD
  53      NOT INFRINGE PRIVATELY OWNED RIGHTS.
  54
  55 ***************************************************************************/
  56
  57 /*
  58  *  rsl_socket.c  -- added 9/30/94
  59  *
  60  *               RSL_SOCKOPEN
  61  *               RSL_SOCKREAD   <-- not yet
  62  *               RSL_SOCKWRITE
  63  *               RSL_SOCKCLOSE
  64  */
  65
  66 #include "stdio.h"
  67 #include "stdlib.h"
  68 #include "rsl.h"
  69
  70 #include <sys/types.h>
  71 #include <sys/socket.h>
  72 #include <netinet/in.h>
  73 #include <netdb.h>
  74 #include <sys/uio.h>
  75
  76
  77 /*@
  78   RSL_SOCKCLOSE - close a socket
  79
  80   Synopsis:
  81   subroutine RSL_SOCKCLOSE ( sid )
  82
  83   Input parameters:
  84 . sid  close a socket opened by RSL_SOCKOPEN
  85
  86   See also:
  87   RSL_SOCKOPEN
  88
  89 @*/
  90 RSL_SOCKCLOSE ( sid0 )
  91   int_p sid0 ;          /* socket id -- set by this routine */
  92 {
  93   int retval ;
  94
  95   RSL_C_IAMMONITOR ( &retval ) ;
  96   if ( retval == 1 )
  97   {
  98     close(*sid0) ;
  99   }
 100 }
 101
 102 static int first = 1 ;
 103
 104
 105 /*@
 106   RSL_SOCKOPEN - open a TCP/IP socket connection for reading or writing
 107
 108   Synopsis:
 109   subroutine RSL_SOCKOPEN ( sid, portnum, hostname, namelen )
 110   integer sid
 111   integer portnum
 112   character*(*) hostname
 113   integer namelen
 114
 115   Input parameters:
 116 . portnum  port to connect to on hostname
 117 . hostname string containing the name of the remote host
 118 . namelen  length in characters of hostname
 119
 120   Output parameters:
 121 . sid   socket descriptor for use in subsequent operations on socket
 122
 123   Notes:
 124   Open a TCP/IP stream socket to a host for later use by RSL_SOCKWRITE and
 125   RSL_SOCKREAD.  Portnum must be specified and it is the number of the
 126   port on the remote host to connect to.   The name of the host
 127   (e.g., xyz.abc.com) is passed to the routine as a string whose length
 128   is passed as namelen.
 129
 130   On return, sid argument contains the socket descriptor.
 131
 132   Example:
 133
 134 $ call rsl_sockopen( sid, 5550, 'xyz.abc.com', 11 )
 135
 136 BREAKTHEEXAMPLECODE
 137
 138   Bugs:
 139
 140   The routine prints a warning message if it fails to open
 141   a socket and returns.  It would be better if this returned
 142   an error code.
 143
 144   See also:
 145   socket(2), RSL_SOCKWRITE, RSL_SOCKREAD, RSL_SOCKCLOSE
 146
 147
 148 @*/
 149 RSL_SOCKOPEN ( sid0, portnum0, hstname0, namelen0 )
 150   int_p sid0 ;          /* socket id -- set by this routine */
 151   int_p portnum0 ;      /* port number input to this routine */
 152   char *hstname0 ;      /* name of host */
 153   int_p namelen0 ;      /* number of characters in hstname0 */
 154 {
 155   int i, retval  ;
 156   char * p, * q, c ;
 157   int portnum ;
 158   char hstname[128] ;
 159
 160   struct sockaddr_in name;
 161   struct hostent *hp, *gethostbyname();
 162
 163
 164
 165   RSL_C_IAMMONITOR ( &retval ) ;
 166   if ( retval == 1 )
 167   {
 168
 169     /* process input args from fortran */
 170     portnum = *portnum0 ;
 171     RSL_TEST_WRN( hstname0 == NULL, "Null hstname argument" ) ;
 172     if ( *namelen0 < 0 || *namelen0 > 64 )
 173     {
 174       sprintf(mess,"Invalid hstname length %d.",*namelen0) ;
 175       RSL_TEST_WRN(1,mess) ;
 176     }
 177     strncpy( hstname, hstname0, *namelen0 ) ;
 178     hstname[*namelen0] = '\0' ;
 179 /* get rid of any white space */
 180     {
 181       char *p, *q;
 182       for ( p = hstname, q = p ; *p ; p++ )
 183         if ( *p != ' ' && *p != '\t' && *p != '\n' ) *q++ = *p ;
 184       *q = '\0' ;
 185     }
 186 /* end mod for removing white space */
 187
 188     /* create socket */
 189     if ( (*sid0 = socket(AF_INET,SOCK_STREAM,0)) < 0 )
 190     {
 191       perror("opening socket") ;
 192       RSL_TEST_WRN(1,"") ;
 193     }
 194
 195     /* connect socket */
 196     name.sin_family = AF_INET;
 197     if((hp = gethostbyname(hstname)) == NULL )
 198     {
 199       sprintf(mess,"%s: unknown host", hstname);
 200       RSL_TEST_WRN(1,mess) ;
 201     }
 202
 203     bcopy((char *)hp -> h_addr, (char *)&name.sin_addr, hp-> h_length);
 204     name.sin_port = htons(portnum);
 205
 206     if(connect(*sid0, (struct sockaddr *)&name, sizeof(name)) < 0)
 207     {
 208       perror("connecting stream socket");
 209       RSL_TEST_WRN(1,"") ;
 210     }
 211     if ( first == 1 )
 212     {
 213       first = 0 ;
 214       setup_socket(*sid0) ;
 215     }
 216   }
 217
 218 fprintf(stderr,"RSL_SOCKOPEN returns *sid0 = %d\n",*sid0) ;
 219   return ;
 220 }
 221
 222 /************/
 223
 224 /*@
 225   RSL_SOCKWRITE - write a distributed two- or three-dimensional array to a socket
 226
 227   Synopsis:
 228   subroutine RSL_SOCKWRITE ( sid, iotag, var, domain, type, glen, llen )
 229
 230   Input parameters:
 231 . socket descriptor
 232 . iotag  tag describing array dimensions
 233 . var    distributed array being written
 234 . domain  domain descriptor
 235 . type   type of an array element
 236 . glen   integer array of global (undecomposed) dimensions of array
 237 . llen  integer array of local static dimensions of array
 238
 239   Notes:
 240   A distributed two- or three-dimensional array will be written to
 241   a socket, previously opened with RSL_SOCKOPEN.  Except as noted below,
 242   the semantics are similar to RSL_READ and RSL_WRITE (which read and
 243   write Fortran files).  The reader should become familiar with these
 244   routines first.
 245
 246   A number of different output options are available, depending on the
 247   value of iotag.  The tags IO2D_IJ, IO2D_JI, IO3D_IJK, or IO3D_JIK specify
 248   Fortran-style record blocking (that is, with Fortran record blocking
 249   information encoded in the data stream).   The data is written to the
 250   socket, but a Fortran record-blocking control word is added to the
 251   beginning and end of each record written to the socket.  (Each 4-byte
 252   control word is a byte
 253   count for the record that follows/preceeds it, and for each n-byte
 254   record written, n+8 bytes will actually be written to the socket).
 255
 256   The tags IO2D_IJ_RAW, IO2D_JI_RAW, IO3D_IJK_RAW, and IO3D_JIK_RAW specify
 257   that the data is to be streamed to the socket as-is, with no additional
 258   record blocking information.
 259
 260   The tags IO2D_IJ_PORTAL, IO2D_JI_PORTAL, IO3D_IJK_PORTAL, and
 261   IO3D_JIK_PORTAL specify that special header packets understood by the
 262   Portal communication library (see reference below) are added to the
 263   beginning of each record.  This header data describes the dimensionality
 264   of the data that will follow and the size of the dimensions; Portal
 265   should be used on the receiving process to properly handle data written
 266   in this mode.
 267
 268   Example:
 269
 270 $ glen(1) = il
 271 $ glen(2) = jl
 272 $ glen(3) = mkx
 273 $ llen(1) = mix
 274 $ llen(2) = mjx
 275 $ llen(3) = mkx
 276
 277 $ m2 = IO2D_IJ_RAW
 278 $ m3 = IO3D_IJK_RAW
 279
 280 $ call rsl_sockwrite(sock,m2,ht,domains(inest),RSL_REAL,glen,llen)
 281 $ call rsl_sockwrite(sock,m3,ta,domains(inest),RSL_REAL,glen,llen)
 282
 283 BREAKTHEEXAMPLECODE
 284
 285   The 2-dimensional distributed array ht and the three-dimensional
 286   distributed array ta are written in raw mode to the socket specified
 287   by sock.  Sock has been opened using RSL_SOCKOPEN.
 288
 289   See also:
 290   ``Portal Communication Library for Run-Time Visualization of Distributed,
 291   Asynchronous Data,'' J.S. Rowlan, B.T. Wightman, Mathematics and Computer
 292   Science Division, Argonne National Laboratory, 1994.  Preprint MCS-P395-1193.
 293
 294   RSL_SOCKOPEN, RSL_SOCKCLOSE, RSL_READ, RSL_WRITE
 295
 296
 297 @*/
 298 RSL_SOCKWRITE ( unit_p, iotag_p, base, d_p, type_p, glen, llen  )
 299   int_p unit_p ;
 300   int_p iotag_p ;
 301   int_p type_p ;
 302   int_p d_p ;
 303   char * base ;
 304   int glen[], llen[] ;
 305 {
 306   rsl_read_req_t request ;
 307   rsl_read_resp_t resp ;
 308   rsl_processor_t me ;
 309   int cursor, mdest, mtag, msglen, dim ;
 310   int mlen, nlen ;
 311   int minelems, majelems ;
 312   unsigned long ig, jg, min, maj, ioffset, joffset, tlen, k ;
 313   void * dex ;
 314   char *pbuf ;
 315   int i_am_monitor ;
 316   int psize, nelem, typelen, nbytes, columnelems  ;
 317   rsl_point_t *domain ;
 318
 319   RSL_TEST_ERR( *d_p < 0 || *d_p >= RSL_MAXDOMAINS,
 320                 "rsl_sockwrite: bad domain descriptor") ;
 321   RSL_TEST_ERR( domain_info[*d_p].valid != RSL_VALID,
 322                 "rsl_sockwrite: invalid domain descriptor" ) ;
 323
 324   mlen = domain_info[*d_p].len_m ;
 325   nlen = domain_info[*d_p].len_n ;
 326   domain = domain_info[*d_p].domain ;
 327
 328   RSL_C_IAMMONITOR ( &i_am_monitor ) ;
 329
 330   me = rsl_c_phys2comp_proc( rsl_myproc ) ;
 331   ioffset = domain_info[*d_p].ilocaloffset ;
 332   joffset = domain_info[*d_p].jlocaloffset ;
 333   tlen = elemsize( *type_p ) ;
 334
 335   request.request_type = RSL_WRITE_REQUEST ;
 336   request.request_mode = MSG_IO_SOCKET ;
 337   request.myproc = rsl_myproc ;
 338   request.base = base ;
 339   request.domain = *d_p ;
 340   request.unit = *unit_p ;
 341   request.type = *type_p ;
 342   request.iotag = *iotag_p ;
 343   request.sequence = io_seq_compute++ ;
 344   switch( *iotag_p )
 345   {
 346
 347   case IO2D_IJ :
 348     request.ndim = 2 ;
 349     request.request_mode2 = MSG_MODE2_FORTRAN ;
 350     break ;
 351   case IO2D_JI :
 352     request.ndim = 2 ;
 353     request.request_mode2 = MSG_MODE2_FORTRAN ;
 354     break ;
 355   case IO3D_IJK :
 356     request.ndim = 3 ;
 357     request.request_mode2 = MSG_MODE2_FORTRAN ;
 358     break ;
 359   case IO3D_JIK :
 360     request.ndim = 3 ;
 361     request.request_mode2 = MSG_MODE2_FORTRAN ;
 362     break ;
 363
 364   case IO2D_IJ_RAW :
 365     request.ndim = 2 ;
 366     request.request_mode2 = MSG_MODE2_RAW ;
 367     break ;
 368   case IO2D_JI_RAW :
 369     request.ndim = 2 ;
 370     request.request_mode2 = MSG_MODE2_RAW ;
 371     break ;
 372   case IO3D_IJK_RAW :
 373     request.ndim = 3 ;
 374     request.request_mode2 = MSG_MODE2_RAW ;
 375     break ;
 376   case IO3D_JIK_RAW :
 377     request.ndim = 3 ;
 378     request.request_mode2 = MSG_MODE2_RAW ;
 379     break ;
 380
 381   case IO2D_IJ_PORTAL :
 382     request.ndim = 2 ;
 383     request.request_mode2 = MSG_MODE2_PORTAL ;
 384     break ;
 385   case IO2D_JI_PORTAL :
 386     request.ndim = 2 ;
 387     request.request_mode2 = MSG_MODE2_PORTAL ;
 388     break ;
 389   case IO3D_IJK_PORTAL :
 390     request.ndim = 3 ;
 391     request.request_mode2 = MSG_MODE2_PORTAL ;
 392     break ;
 393   case IO3D_JIK_PORTAL :
 394     request.ndim = 3 ;
 395     request.request_mode2 = MSG_MODE2_PORTAL ;
 396     break ;
 397
 398   case IO2D_IJ_88 :
 399     request.ndim = 2 ;
 400     request.request_mode2 = MSG_MODE2_88 ;
 401     break ;
 402   case IO2D_JI_88 :
 403     request.ndim = 2 ;
 404     request.request_mode2 = MSG_MODE2_88 ;
 405     break ;
 406   case IO3D_IJK_88 :
 407     request.ndim = 3 ;
 408     request.request_mode2 = MSG_MODE2_88 ;
 409     break ;
 410   case IO3D_JIK_88 :
 411     request.ndim = 3 ;
 412     request.request_mode2 = MSG_MODE2_88 ;
 413     break ;
 414
 415   default:
 416     RSL_TEST_ERR(1,"rsl_read: unknown data tag") ;
 417   }
 418
 419   for ( dim = 0 ; dim < request.ndim ; dim++ )
 420   {
 421     request.glen[dim] = glen[dim] ;
 422     request.llen[dim] = llen[dim] ;
 423   }
 424
 425   /* figure out size of buffer needed */
 426   nelem = 1 ;
 427   for  ( dim = 0 ; dim < request.ndim ; dim++ )
 428   {
 429     nelem *= request.glen[dim] ;
 430   }
 431   typelen = elemsize( request.type ) ;
 432   nbytes = nelem * typelen ;
 433
 434   switch ( request.iotag )
 435   {
 436
 437   case IO2D_IJ :
 438   case IO2D_IJ_RAW :
 439   case IO2D_IJ_PORTAL :
 440   case IO2D_IJ_88 :
 441     columnelems = 1 ;
 442     minelems = request.glen[0] ;
 443     majelems = request.glen[1] ;
 444     break ;
 445   case IO2D_JI :
 446   case IO2D_JI_RAW :
 447   case IO2D_JI_PORTAL :
 448   case IO2D_JI_88 :
 449     columnelems = 1 ;
 450     minelems = request.glen[1] ;
 451     majelems = request.glen[0] ;
 452     break ;
 453   case IO3D_IJK :
 454   case IO3D_IJK_RAW :
 455   case IO3D_IJK_PORTAL :
 456   case IO3D_IJK_88 :
 457     columnelems = request.llen[2] ;
 458     minelems = request.glen[0] ;
 459     majelems = request.glen[1] ;
 460     break ;
 461   case IO3D_JIK :
 462   case IO3D_JIK_RAW :
 463   case IO3D_JIK_PORTAL :
 464   case IO3D_JIK_88 :
 465     columnelems = request.llen[2] ;
 466     minelems = request.glen[1] ;
 467     majelems = request.glen[0] ;
 468     break ;
 469
 470   default:
 471     RSL_TEST_ERR(1,"handle_write_request: unknown data tag") ;
 472   }
 473
 474
 475   /*  figure out size for this processor */
 476   pbuf = NULL ;
 477   psize = 0 ;
 478
 479   RSL_TEST_ERR( majelems <= 0, "Major dim spec on write is zero or less.") ;
 480   RSL_TEST_ERR( minelems <= 0, "Minor dim spec on write is zero or less.") ;
 481   if ( majelems > domain_info[request.domain].len_n )
 482   { sprintf(mess,"Major dim spec on write (%d) greater than global domain definition in that dimension (%d)\n",majelems,domain_info[request.domain].len_n) ;
 483     RSL_TEST_ERR(1,mess) ; }
 484   if ( minelems > domain_info[request.domain].len_m )
 485   { sprintf(mess,"Minor dim spec on write (%d) greater than global domain definition in that dimension (%d)\n",minelems,domain_info[request.domain].len_m) ;
 486     RSL_TEST_ERR(1,mess) ; }
 487
 488   for ( jg = 0 ; jg < majelems ; jg++ )
 489   {
 490     for ( ig = 0 ; ig < minelems ; ig++ )
 491     {
 492       if ( me == domain[INDEX_2(jg,ig,mlen)].P )
 493         psize += columnelems * typelen ;
 494     }
 495   }
 496
 497
 498   pbuf = RSL_MALLOC( char, psize ) ;
 499
 500   cursor = 0 ;
 501
 502 #if 0
 503   for ( jg = 0 ; jg < domain_info[*d_p].len_n ; jg++ )
 504   {
 505     for ( ig = 0 ; ig < domain_info[*d_p].len_m ; ig++ )
 506     {
 507 #else
 508   for ( jg = 0 ; jg < majelems ; jg++ )
 509   {
 510     for ( ig = 0 ; ig < minelems ; ig++ )
 511     {
 512 #endif
 513       if ( me == domain[INDEX_2(jg,ig,mlen)].P )
 514       {
 515         switch( *iotag_p )
 516         {
 517         case IO2D_IJ :
 518         case IO2D_IJ_RAW :
 519         case IO2D_IJ_PORTAL :
 520         case IO2D_IJ_88 :
 521           min = ig - ioffset ;
 522           maj = jg - joffset ;
 523           dex = base+tlen*(min+maj*llen[0]) ;
 524           bcopy(dex,&(pbuf[cursor]),tlen) ;
 525           cursor += tlen ;
 526           break ;
 527         case IO2D_JI :
 528         case IO2D_JI_RAW :
 529         case IO2D_JI_PORTAL :
 530         case IO2D_JI_88 :
 531           min = jg - joffset ;
 532           maj = ig - ioffset ;
 533           dex = base+tlen*(min+maj*llen[0]) ;
 534           bcopy(dex,&(pbuf[cursor]),tlen) ;
 535           cursor += tlen ;
 536           break ;
 537         case IO3D_IJK :
 538         case IO3D_IJK_RAW :
 539         case IO3D_IJK_PORTAL :
 540         case IO3D_IJK_88 :
 541           min = ig - ioffset ;
 542           maj = jg - joffset ;
 543           for ( k = 0 ; k < llen[2] ; k++ )
 544           {
 545             dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
 546             bcopy(dex,&(pbuf[cursor]),tlen) ;
 547             cursor += tlen ;
 548           }
 549           break ;
 550         case IO3D_JIK :
 551         case IO3D_JIK_RAW :
 552         case IO3D_JIK_PORTAL :
 553         case IO3D_JIK_88 :
 554           min = jg - ioffset ;
 555           maj = ig - joffset ;
 556           for ( k = 0 ; k < llen[2] ; k++ )
 557           {
 558             dex = base+tlen*(min+llen[0]*(maj+k*llen[1])) ;
 559             bcopy(dex,&(pbuf[cursor]),tlen) ;
 560             cursor += tlen ;
 561           }
 562           break ;
 563         }
 564       }
 565     }
 566   }
 567   if ( pbuf != NULL )
 568   {
 569   if ( i_am_monitor )
 570   {
 571     handle_write_request( &request, nelem, psize, pbuf ) ;
 572   }
 573   else
 574   {
 575     mdest = RSL_C_MONITOR_PROC () ;
 576     msglen = psize ;
 577     mtag = MTYPE_FROMTO( MSG_WRITE_COMPUTE_RESPONSE, rsl_myproc, mdest ) ;
 578     RSL_SEND( pbuf, msglen, mtag, mdest ) ;
 579   }
 580
 581   RSL_FREE( pbuf ) ;
 582   }
 583 }
 584