home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / general / procssng / ccs / ccs-11tl.lha / lbl / lib / fits_io.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-24  |  11.7 KB  |  456 lines
  1. /*    FITS_IO . C
  2. %
  3. %    Byte based I/O utilities.
  4. %    It also contains host checking, long (LongSwap) and Short Swap.
  5. %    There are two file open system:
  6. %        One is for regular file open.
  7. %    The other one, which is for debugging, must use standard I/O.
  8. %
  9. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  10.  
  11. This software is copyright (C) by the Lawrence Berkeley Laboratory.
  12. Permission is granted to reproduce this software for non-commercial
  13. purposes provided that this notice is left intact.
  14.  
  15. It is acknowledged that the U.S. Government has rights to this software
  16. under Contract DE-AC03-765F00098 between the U.S.  Department of Energy
  17. and the University of California.
  18.  
  19. This software is provided as a professional and academic contribution
  20. for joint exchange. Thus, it is experimental, and is provided ``as is'',
  21. with no warranties of any kind whatsoever, no support, no promise of
  22. updates, or printed documentation. By using this software, you
  23. acknowledge that the Lawrence Berkeley Laboratory and Regents of the
  24. University of California shall have no liability with respect to the
  25. infringement of other copyrights by any part of this software.
  26.  
  27. For further information about this notice, contact William Johnston,
  28. Bld. 50B, Rm. 2239, Lawrence Berkeley Laboratory, Berkeley, CA, 94720.
  29. (wejohnston@lbl.gov)
  30.  
  31. For further information about this software, contact:
  32.     Jin Guojun
  33.     Bld. 50B, Rm. 2275, Lawrence Berkeley Laboratory, Berkeley, CA, 94720.
  34.     g_jin@lbl.gov
  35.  
  36. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  37. %
  38. % AUTHOR:    Guojun Jin - LBL    8/1/90
  39. */
  40.  
  41. #include "header.def"
  42. #include "imagedef.h"
  43.  
  44. Sonion    sonion;
  45. int    hostype,
  46.     flag,
  47.     FORTRAN,    /* Fortran file flag    */
  48.     FTy = 'v',    /* Fortran file type    */
  49.     FFCL;        /* Fortran Ctrl word length:    UNIX = 4, PC = 1. */
  50.  
  51.  
  52. short    ShortSwap(iu)
  53. short    iu;
  54. {
  55. char    tmp;
  56. /* if (hostype != 2 && hostype != 5)    return; */
  57. sonion.ilen = iu;
  58. tmp = sonion.ichar[0];
  59. sonion.ichar[0] = sonion.ichar[1];
  60. sonion.ichar[1] = tmp;
  61. return    sonion.ilen;
  62. }
  63.  
  64. long LongSwap(inval)  /*    swap 4 byte integer    */
  65. long inval;
  66. {
  67. SwapUnion    onion;
  68. char    temp;
  69.  
  70. /*    byte swap the input field    */
  71.     onion.llen = inval;
  72.     temp = onion.ichar[0];
  73.     onion.ichar[0]=onion.ichar[3];
  74.     onion.ichar[3]=temp;
  75.     temp = onion.ichar[1];
  76.     onion.ichar[1] = onion.ichar[2];
  77.     onion.ichar[2] = temp;
  78. return (onion.llen);
  79. }
  80.  
  81. /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  82. %    subroutine check_host - find out what kind of machine    %
  83. %    we are on. This subroutine checks the attributes of    %
  84. %    the host computer and returns a host code number.    %
  85. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
  86.  
  87. check_host()
  88. {
  89. int    swap, host=0, bits;
  90. char    hostname[80];
  91.  
  92. strcpy(hostname, "Host ");
  93.  
  94. bits = sizeof(bits) << 3;
  95.  
  96. if (bits == 8)
  97.     strcat(hostname, "0 - 8-bit machine.");
  98. else    {
  99.     sonion.ichar[0] = 1;
  100.     sonion.ichar[1] = 0;
  101.     swap = (sonion.ilen != 1);
  102.  
  103.     if (bits==16)    {
  104.     host = 1 << swap;        /* 1 = IBM PC host  */
  105.     sprintf(hostname + strlen(hostname),
  106.         "%d - 16 bit integers with%s swapping, no var len support.",
  107.         host, host & 1 ? "out" : " ");
  108.     } else if (bits==32)    {
  109.     if (!swap) {
  110.         host = 3;    /* VAX host with var length support */
  111.         strcat(hostname, "3,4 - 32 bit integers without swapping.");
  112.     } else    {
  113.         host = 5;    /* OTHER 32-bit host  */
  114.     }
  115.     } else    {    /* 64 or more     */
  116.         host = 6 + swap;
  117.     }
  118.     if (host > 4)
  119.     sprintf(hostname + strlen(hostname),
  120.         "%d - %d-bit integers with%s swapping, no var len support.",
  121.         host, 32 << (host > 5), host & 1 ? " " : "out");
  122. }
  123. message("%s : %s\n", Progname, hostname);
  124. return    host;
  125. }
  126.  
  127. /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  128. *    subroutine get_files - get input filenames and open.        *
  129. *    If No input file name and No msp given, stdin will be used.    *
  130. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
  131.  
  132. FILE* get_infile(hostype, inname, msp)
  133. int    hostype;
  134. char    *inname, *msp;
  135. {
  136. char    YN[4];
  137. short    shortint;
  138. FILE*    in_file;
  139.  
  140. if (!inname[0] || inname[0] == '.')
  141. {
  142.     if (strlen(msp))
  143.     {    message("host = %d\n\n%s:    ", hostype, msp);
  144.         gets(inname);
  145.     }
  146.     else    return    stdin;
  147. }
  148.  
  149. if (hostype == 1 || hostype == 2)
  150.     in_file = fopen(inname, "rb");
  151.  
  152. else if (hostype == 3 || hostype == 5)
  153.     in_file = fopen(inname, "r");
  154. if (in_file == NULL)
  155.     syserr("\ncan't open input file: %s\n", inname);
  156.  
  157. /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  158. * If we are on a vax see if the file is in var length format.  *
  159. * This logic is in here in case the vax file has been stored   *
  160. * in fixed or undefined format.  This might be necessary since *
  161. * vax variable length files can't be moved to other computer   *
  162. * systems with standard comm programs (kermit, for example).   *
  163. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
  164. if (hostype==3){
  165.     fread(&shortint, 2, 1, in_file);
  166.     if (shortint > 0 && shortint < 80){
  167.         hostype = 4;    /* change host to 4    */
  168.         strcpy(YN, "not");
  169.     }
  170.     else    YN[0] = 0;    /* not extra message    */
  171.     msg("This is %s a VAX variable length file.\n", YN);
  172.     fseek(in_file, 0, SEEK_SET);    /* reposition to beginning of file */
  173. }
  174. return    in_file;
  175. }
  176.  
  177. FILE*    get_outfile(hostype, outname, msp)
  178. int    hostype;
  179. char    *outname, *msp;
  180. {
  181. FILE*    out_file;
  182.  
  183. if (!outname[0] || outname[0] == '.')
  184. {
  185.     msg("\n%s:    ", msp);
  186.     gets(outname);
  187. }
  188. if (hostype==1 || hostype==2 || hostype==5)
  189.     out_file = fopen(outname, "wb");
  190. else    out_file = fopen(outname, "w");
  191. if (!out_file)
  192.     syserr("\ncan't open output file: %s\n", outname);
  193. return    out_file;
  194. }
  195.  
  196. /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  197. * subroutine read_var - read variable length records from input file    *
  198. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
  199.  
  200. long    read_var(ibuf, ifp, hostype, FTy)
  201. byte    *ibuf;
  202. FILE    *ifp;
  203. int    hostype;
  204. bool    FTy;
  205. {
  206. long    resultu, ulen, resultr;
  207. short    vlen, result;
  208. byte    pclen;
  209.  
  210. switch (hostype){
  211.     case 1: /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  212.         *    IBM PC host,    no swap needed        *
  213.         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
  214.  
  215.     case 3: /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  216.         *    VAX host with variable length support    *
  217.         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
  218.     switch (FTy)
  219.     {
  220.         case 'u':
  221.         result = fread(&ulen, 1, sizeof(ulen), ifp);
  222.         ulen = LongSwap(ulen);
  223.         if (ulen > MaxUNIXFortranBlock)    return    -1;
  224.         break;
  225.         case 'v':
  226.         result = fread(&vlen, 1, sizeof(vlen), ifp);
  227.         fread(&flag, 1, sizeof(flag), ifp);
  228.         ulen = (long)(vlen - 2);
  229.         if (ulen > MaxVAXFortranBlock)    return    -1;
  230.         break;
  231.         case 'p':
  232.         result = fread(&pclen, 1, sizeof(pclen), ifp);
  233.         ulen = (long)pclen;
  234.         if (ulen > MaxPCFortranBlock)    return    -1;
  235.         break;
  236.         default:    return    -1;
  237.     }
  238.     if (ulen < 0)    return    -1;
  239.     resultr = fread(ibuf, 1, ulen, ifp);
  240.     switch (FTy)
  241.     {
  242.         case 'u':
  243.         fread(&resultu, 1, sizeof(resultu), ifp);
  244.         resultu = LongSwap(resultu);
  245.         if (resultu != resultr)    return    -1;
  246.         break;
  247.         case 'p':
  248.         fread(&pclen, 1, sizeof(pclen), ifp);
  249.         if (pclen != (byte)resultr)
  250.             return    -1;
  251.     }
  252.     return (resultr);
  253.  
  254.     case 2: /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  255.         *    Macintosh host        *
  256.         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
  257.     switch (FTy)
  258.     {
  259.         case 'u':
  260.         result = fread(&ulen, 1, sizeof(ulen), ifp);
  261.         if (ulen > MaxUNIXFortranBlock)    return    -1;
  262.         break;
  263.         case 'v':
  264.         result = fread(&vlen, 1, sizeof(vlen), ifp);
  265.         fread(&flag, 1, sizeof(flag), ifp);
  266.         ulen = LongSwap((long)(vlen - 2));
  267.         if (ulen > MaxVAXFortranBlock)    return    -1;
  268.         break;
  269.         case 'p':
  270.         result = fread(&pclen, 1, sizeof(pclen), ifp);
  271.         ulen = (long)pclen;
  272.         if (ulen > MaxPCFortranBlock)    return    -1;
  273.         break;
  274.         default:    return    -1;
  275.     }
  276.     if (ulen < 0)    return    -1;
  277.     resultr = fread(ibuf, 1, ulen, ifp);
  278.     switch (FTy)
  279.     {
  280.         case 'u':
  281.         fread(&resultu, 1, sizeof(resultu), ifp);
  282.         if (resultu != resultr)
  283.             return    -1;
  284.         break;
  285.         case 'p':
  286.         fread(&pclen, 1, sizeof(pclen), ifp);
  287.         if (pclen != (byte)resultr)
  288.             return    -1;
  289.     }
  290.  
  291. /*msg("vlen=%04x, result=%d, get = %d\n", nlen, result, vlen);*/
  292.     return (resultr);
  293.     /*    byte swap the vlen field            */
  294. /*    nlen = LongSwap(nlen);     left out of earlier versions    */
  295.  
  296.     case 4: /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  297.         *    VAX host, but not a variable vlen file    *
  298.         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
  299.  
  300.     switch (FTy)
  301.     {
  302.         case 'u':
  303.         resultu = fread(&ulen, 1, sizeof(ulen), ifp);
  304.         ulen = LongSwap(ulen);
  305.         if (ulen > MaxUNIXFortranBlock)    return    -1;
  306.         break;
  307.         case 'v':
  308.         result = fread(&vlen, 1, sizeof(vlen), ifp);
  309.         fread(&flag, 1, sizeof(flag), ifp);
  310.         ulen = (long)(vlen - 2);
  311.         if (ulen > MaxVAXFortranBlock)    return    -1;
  312.         break;
  313.         case 'p':
  314.         result = fread(&pclen, 1, sizeof(pclen), ifp);
  315.         ulen = (long)pclen;
  316.         if (ulen > MaxPCFortranBlock)    return    -1;
  317.         break;
  318.         default:    return    -1;
  319.     }
  320.  
  321.     if (ulen < 0 || ulen > MaxVAXFortranBlock)
  322.         return    -1;
  323.     resultr = fread(ibuf, 1, ulen, ifp);
  324.     /* check to see if we crossed a vax record boundary      */
  325.     while (ulen > vlen)
  326.     resultr += fread(ibuf + vlen, ulen - vlen, 1, ifp);
  327.     switch (FTy)
  328.     {
  329.         case 'u':
  330.         fread(&resultu, 1, sizeof(resultu), ifp);
  331.         resultu = LongSwap(resultu);
  332.         if (resultu != resultr)
  333.             return    -1;
  334.         break;
  335.         case 'p':
  336.         fread(&pclen, 1, sizeof(pclen), ifp);
  337.         if (pclen != (byte)resultr)
  338.             return    -1;
  339.     }
  340.     return (resultr);
  341.  
  342.     case 5: /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  343.         * Unix workstation host (non-byte-swapped 32 bit host)    *
  344.         %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
  345.     switch (FTy)
  346.     {
  347.         case 'u':
  348.         result = fread(&ulen, 1, sizeof(ulen), ifp);
  349.         if (ulen > MaxUNIXFortranBlock)    return    -1;
  350.         break;
  351.         case 'v':
  352.         result = fread(&vlen, 1, sizeof(vlen), ifp);
  353.         fread(&flag, 1, sizeof(flag), ifp);
  354.         ulen = LongSwap((long)(vlen - 2));
  355.         if (ulen > MaxVAXFortranBlock)    return    -1;
  356.         break;
  357.         case 'p':
  358.         result = fread(&pclen, 1, sizeof(pclen), ifp);
  359.         ulen = (long)pclen;
  360.         if (ulen > MaxPCFortranBlock)    return    -1;
  361.         break;
  362.         default:    return    -1;
  363.     }
  364.     if (ulen < 0)    return    -1;
  365.     resultr = fread(ibuf, 1, ulen, ifp);
  366.     switch (FTy)
  367.     {
  368.         case 'u':
  369.         fread(&resultu, 1, sizeof(resultu), ifp);
  370.         if (resultu != resultr)
  371.             return    -1;
  372.         break;
  373.         case 'p':
  374.         fread(&pclen, 1, sizeof(pclen), ifp);
  375.         if (pclen != (byte)resultr)
  376.             return    -1;
  377.     }
  378.  
  379. /*msg("vlen=%04x, result=%d, get = %d\n", nlen, result, vlen);*/
  380.     return (resultr);
  381.     }
  382. }
  383.  
  384. /*    write data to a file. if successful, return 0    */
  385. update(buf, psize, length, ofp)
  386. VType    *buf;
  387. MType    length;
  388. FILE    *ofp;
  389. {
  390. MType    comfirm = fwrite(buf, psize, length, ofp);
  391.  
  392. if (comfirm != length)
  393.     message("update[%ld] %ld\n", length, comfirm);
  394. return    length - comfirm;
  395. }
  396.  
  397. bool    comfirm_host(img, hostype, FTy)
  398. U_IMAGE    *img;
  399. bool    FTy;
  400. {
  401. char    buf[10240];
  402.  
  403.     if (FTy == 'p')                /* a IBM/PC Version    */
  404.        if (getc(img->IN_FP) != 'K')
  405.         goto    findout;        /* not a PC Version    */
  406.     if (read_var(buf, img->IN_FP, hostype, FTy) > 0)
  407.     {    fseek(img->IN_FP, 0, SEEK_SET);
  408.         if (FTy == 'p')            /* if it's a PC Version    */
  409.             getc(img->IN_FP);    /*    pass 'K' sign    */
  410.         FORTRAN = True;
  411.     }
  412.     else
  413. findout:while(FTy)            /* find out what version is    */
  414.     {
  415.         fseek(img->IN_FP, 0, SEEK_SET);    /* back  to begining    */
  416.         if (getc(img->IN_FP) == 'K') {
  417.         if (read_var(buf, img->IN_FP, hostype, 'p') > 0)
  418.         {    mesg("PC Version\n");
  419.             FTy = 'p';
  420.             fseek(img->IN_FP, 1, SEEK_SET);
  421.             FORTRAN = True;
  422.             break;
  423.         }
  424.         }
  425.         fseek(img->IN_FP, 0, SEEK_SET);
  426.         if (read_var(buf, img->IN_FP, hostype, 'u') > 0){
  427.         mesg("UNIX Version\n");
  428.         FTy = 'u';
  429.         fseek(img->IN_FP, 0, SEEK_SET);
  430.         FORTRAN = True;
  431.         break;
  432.         }
  433.         fseek(img->IN_FP, 0, SEEK_SET);
  434.         if (read_var(buf, img->IN_FP, hostype, 'v') > 0) {
  435.         mesg("VMS Version\n");
  436.         FTy = 'v';
  437.         fseek(img->IN_FP, 0, SEEK_SET);
  438.         FORTRAN = True;
  439.         break;
  440.         }
  441.         if (FORTRAN)
  442.         mesg("Warning: Unknow Version\n"),    FTy = NULL;
  443.         break;
  444.     }    /* end while */
  445.     if (FORTRAN)
  446.     switch(FTy)
  447.     {
  448.     case 'u':    FFCL = 4;    break;
  449.     case 'p':    FFCL = 1;    break;
  450.     case False:    FORTRAN = FTy;
  451.         perror("File type error: change to nonFORTRAN mode\n");
  452.     }
  453.     fseek(img->IN_FP, 0, SEEK_SET);
  454. return    FTy;
  455. }
  456.