I added some new header files. These header files begin with the UCLA disclaimer. All changes that I made in other header files or in the source code itself are labeled with JES 90. Transferring HDF files to IBM MVS systems HDF files always have to be transfered as binary files. You can transfer the HDF files that I put on FTP.NCSA.UIUC.EDU as RECFM=F, LRECL=512, BLKSIZE=512 because they were either created on or converted to MVS. All other HDF files have to be transfered as RECFM=U BLKSIZE=512. This is because they are in 512 byte blocks with a short last block. The short last block can be of any size. I had to write a small program to convert from RECFM=U, BLKSIZE=512 to RECFM=F, BLKSIZE=512 so that HDF can read them. This is because HDF uses the ftell C function and that function works only for RECFM=F datasets. This program is called convert.file.recfmu.to.recfmf. When I allocate an output HDF file on the IBM mainframe, I allocate the file as RECFM=F, BLKSIZE=512. The system automatically pads out the last block with hex 00's. This is ok since no pointer points to the hex 00's at the end of the file. I can transfer this file to another machine and use it ok there. About function names The names of certain HDF functions had to be changed to the short form as given in the HDF documentation. I did this only where there were conflicts. The C compiler cuts the names off after the 8'th character. DFR8getimage --> DFR8GETI VS FORTRAN cuts off long names using the first 4 and last 3 characters: C: DFR8getimage --> DFR8GETI FORTRAN: DFR8getimage --> DFR8AGE Therefore routine names called from FORTRAN can have at most 7 characters. With the DF routines there are no conflicts. However, for example with the DFSD (scientific) routines there are conflicts: DFSDgetdims --> DFSDGETD DFSDgetdimscale --> DFSDGETD DFSDgetdimstrs --> DFSDGETD I made the following name changes: DF C Use the standard (long) form of the names FORTRAN DF routines can't be called from FORTRAN except for the following routine for which you must use a shortened name: Documented Name Name to use DFfindnextref dfindnr The reason the DF routines cannot be called directly from FORTRAN is discussed below. DFAN C Use the shortened form of all names as described in Appendex C of the HDF manual "Eight-Character FORTRAN Names". You must use the following additional abbreviated names: Documented Name Name to use DFANgetfidlen, dagflen DFANgetfid, dagfid DFANgetfdslen, dagfdlen DFANgetfds, dagfds DFANaddfid, daafid DFANaddfds, daafds The names of internal routines also had to be shortened. Note that these routines are never called directly by users. Documented Name Name to use DFANIopen, daiopen DFANIlocate, dailoc DFANIaddentry, daigaent DFANIgetannlen, daigalen DFANIgetann, daigann DFANIputann, daipann DFANIlablist, dailabl DFANIaddfann, daiafann DFANIgetfannlen, daigflen DFANIgetfann, daigfann FORTRAN You must use the same shortened names that you use from C. DFGR C These are all routines that are internal to the DF24 routines and are never called directly by users. Their names had to be shortened as follows: Documented Name Name to use DFGRgetlutdims, dgglutdi DFGRreqlutil, dgrlutil DFGRgetlut, dgglut DFGRgetimdims, dggimdim DFGRreqimil, dgrimil DFGRgetimage, dggimage DFGRsetcompress, dgscomp DFGRsetlutdims, dgslutdi DFGRsetlut, dgslut DFGRaddlut, dgalut DFGRsetimdims, dgstimdi DFGRaddimage, dgaimage DFGRreadref, dgrdref DFGRgetrig, dggrig DFGRaddrig, dgarig DFGRIopen, dgiopen DFGRIriginfo, dgirigin DFGRIgetdims, dgigdims DFGRIreqil, dgiril DFGRIgetimlut, dgigimlt DFGRIsetdims, dgisdims DFGRIsetil, dgisil DFGRIrestart, dgifirst DFGRIaddimlut, dgiadlut DFP C Use the standard (long) form of the names FORTRAN Use the shortened form of all names as described in Appendex C of the HDF manual "Eight-Character FORTRAN Names". DFR8 C Use the standard (long) form of the names FORTRAN Use the shortened form of all names as described in Appendex C of the HDF manual "Eight-Character FORTRAN Names". DFSD C Use the shortened form of all names as described in Appendex C of the HDF manual "Eight-Character FORTRAN Names". Also use these abbreviated names: Documented Name Name to use DFSDnumber dsnumber DFSDlastref dslastref DFSDgsdg dsgsdg DFSDpsdg dspsdg The names of internal routines also had to be shortened. Note that these routines are never called directly by users. Documented Name Name to use DFSDIopen dsIopen DFSDIsdginfo dsIsdginfo DFSDIclear dsIclear DFSDIgetdata dsIgetdata DFSDIputdata dsIputdata DFSDIgetslice dsIgetslice DFSDIputslice dsIputslice DFCVieeeF2vaxf DFCVi2vF DFCVvaxF2ieeeF DFCVv2iF Calling C from FORTRAN HDF routines are callable from C or FORTRAN. NCSA does this by making a FORTRAN routine of the same name as the C routine. The user calls the FORTRAN routine which calls an intermediated C routine which calls the real C routine of the same name as the FORTRAN routine. Of course this doesn't work on IBM systems. IBM advertises that C can be called from FORTRAN simply by including a #pragma linkage(_____, FORTRAN) statement for each routine. However: The C/FORTRAN connection did not work in versions of the compiler lower than Version 1 Release 2. Therefore, you are required to compile all the C routines with IBM C/370 Version 1 Release 2 or greater. My implementation throws out all the NCSA FORTRAN and C go-between routines and uses #pragma. When you see LEVEL=N on the JCL for my install jobs, that is to select the right version of C (the pre-production version here). At other IBM sites, that may be the production version or they might have other ways of selecting different versions. Since the DF routines are called by all the other routines, they always have to be callable from C. That is why there is no FORTRAN callable version of the DF routines. User's of the FORTRAN version should be warned that FORTRAN stores 2-d matrices columnwise and the C stores them rowwise. Since FORTRAN is calling C directly, there is no correction for this. The HDF routines do not even know they are being called from FORTRAN. Header files I took the header (.H) files from NCSA and put them into a library (PDS) named HDF3.HEADER. The ones with no comments next to them are unchanged. CONSTNTS DF DFAN has JES mods DFCONVER a JES reorganization DFF DFGR has JES mods DFI has JES mods DFIVMS DFRIG DFSD has JES mods DFLINK added by JES DFLINKAN added by JES DFLINKP added by JES DFLINKR8 added by JES DFLINKSD added by JES DFLINK24 added by JES Of the source files, I only changed the following ones. The go-between routines between FORTRAN and C are not needed and are not part of this port. DF has JES mods DFAN has JES mods DFCOMP DFGR DFGROUP DFIMCOMP DFKIT has JES mods DFP DFR8 DFR8.LASTREF added by JES DFSD has JES mods DFUTIL DF24 HEADER member DFCONVER: this is the convert macro I modified both this DFCONVER header file and the DFconvert function to call the Cornell routines for converting between IBM's floating point format and IEEE and vice versa. HEADER member DFI: this includes all the machine dependencies 1) I have modified the machine dependent "defines" as follows: First, I have added a new type IBM. #define IBM HDF tests this everywhere else to see if its compiling code for and IBM mainframe and uses it to select code to include. 2) I have added IBM to the list of valid machine types in: #if !defined(IRIS4) && !defined(MAC) && !defined(UNICOS) &&!defined(IBM) 3) #define DF_BUFFIO 4) #define DF_DYNAMIC This says we can dynamically allocate memory. 5) I have added a new Machine type (MT) as follows for IBM. #define DFMT_IBM 0x1555 /* JES 90 */ 6) And a new class info code for IBM floating point: #define DFNTF_IBM 5 /*IBM mainframe */ /* JES 90 */ 7) This file includes machine dependencies for each of the machines. I have added the following section for IBM mainframes. #ifdef IBM /* START JES 90 */ #include typedef short int16; typedef unsigned short uint16; typedef long int int32; typedef float float32; #define DFmovmem(from, to, len) memcpy(to, from, len) #define UINT16READ(p, x) { DFmovmem(p, &x, 2); p+=2; } #define INT16READ(p, x) { DFmovmem(p, &x, 2); p+=2; } #define INT32READ(p, x) { DFmovmem(p, &x, 4); p+=4; } #define UINT16WRITE(p, x) { DFmovmem(&x, p, 2); p+=2; } #define INT16WRITE(p, x) { DFmovmem(&x, p, 2); p+=2; } #define INT16WRITE(p, x) { DFmovmem(&x, p, 2); p+=2; } #define INT32WRITE(p, x) { DFmovmem(&x, p, 4); p+=4; } #define DF_MT DFMT_IBM #define DF_CAPFNAMES #undef DF_STRUCTOK #endif /* IBM */ The typedef statements define int16, uint16, int32, and float32 and say what they are for IBM's C/370. The define statements implement the UINT16READ etc. statements that occur in the code. #undef DF_STRUCTOK indicates that we can't use structure names for input/output. 8) I have defined the open parameters for IBM as follows: #else /*PC*/ # ifdef IBM /* START JES 90 */ # define DF_RDACCESS "rb" # define DF_WRACCESS "rb+" # define DF_CRACCESS "wb+" # else /* IBM */ /* END JES 90 */ # define DF_RDACCESS "r" # define DF_WRACCESS "r+" # endif /* IBM */ /* JES 90 */ #endif /*PC*/ 9) And I don't have to include these defines since I have already included string.h: #ifndef MAC #ifndef IBM /* JES 90 */ char *strncpy(); char *strcpy(); char *malloc(); char *memcpy(); #endif /* IBM */ /* JES 90 */ #endif /* !MAC */ HEADER member DFAN: this is the header for annotation I added a set of #pragma statements to shorten the routine names. HEADER member DFSD: this is the header for scientific data 1) I had to make this change because of shortening DFSDIopen to dsIopen. #ifndef VMS #ifdef IBM /* JES 90 */ DF* dsIopen(); /* JES 90 */ #else /* IBM */ /* JES 90 */ DF* DFSDIopen(); #endif /* IBM */ /* JES 90 */ #else /*VMS*/ DF* _DFSDIopen(); #endif 2) I also typed these: #ifdef IBM /* JES 90 */ int dsIsdginfo( ); /* JES 90 */ int dsIclear( ); /* JES 90 */ int dsIgetdata( ); /* JES 90 */ int dsIgetslice( ); /* JES 90 */ int dsIputdata( ); /* JES 90 */ int dsIputslice( ); /* JES 90 */ #endif /* IBM */ /* JES 90 */ HEADER member DFGR: this is the header for raster 24 I added a set of #pragma statements to shorten the routine names. HEADER members DFLINK, DFLINKAN, DFLINKP, DFLINKR8, DFLINKSD, and DFLINK24 These contain the #pragma statements needed to link C to FORTRAN are use to create the FORTRAN versions of the load modules. File DF: Global definitions: I have changed the definition of CKSEEKEND because of problems which I don't remember the nature of now. Anyway, it works if you always rewind the file before fseeking to the end. The problem necessitating this may be a bug in the IBM C compiler. #ifdef IBM /* START JES 90 */ #define CKSEEKEND(x,y,z, ret) { rewind( x ); \ if (DF_SKEND( x,(long)y,z) <0) \ {DFerror = DFE_SEEKERROR; return(ret); } } #else /* END JES 90 */ #define CKSEEKEND(x,y,z, ret) { if (DF_SKEND( x,(long)y,z) <0) \ {DFerror = DFE_SEEKERROR; return(ret); } } #endif /* JES 90 */ DFopen function: The open function does not exist with our C compiler. I have effectively gotten rid of the unresolved external reference caused by the calling the open function when the machine type is IBM. The open function is not compiled in when machine is IBM. The other changes are described in the comment blocks that I have added to the program. Basically, there are four types of HDF calls: - Those that create an HDF file, like DFR8putimage - Those that add to an existing HDF file, like DFR8addimage - Those that read and existing HDF file, like FGR8getimage - Those that either create an HDF file or add to it if it exists like DF24addimage. There are two ways to create new datasets on IBM systems: - Either the dataset, even though new, is created either with a DD statement or a TSO allocate statement. In that case, HDF can not accually create a file even though that's what it thinks its doing because an empty one has been precreated. - Or the datset is being created by dsname, in which case HDF has to create it. This is made more complicated by an HDF function that thinks that it is either creating an HDF file or adding to it because if HDF finds a dataset out there, it decides its adding. However, that dataset might have been created by the DD or ALLOCATE statement and is therefore empty. In that case, I had to remove the HDF check for its magic bytes which it uses to confirm that the dataset is usable. /************************************************/ /* Either: the file was supposed to be created */ /* or it did not exist */ /* note that for ibm systems, if a dd statement */ /* was supplied and the file was supposed to */ /* be created then an empty one accually exists */ /************************************************/ if (created || DF_OPENERR(DFlist??(i??).file = DF_OPEN(name, DF_RDACCESS))) { /*******************************************/ /* if we are supposed to be reading a file */ /* that doesnt exist then its an error */ /*******************************************/ if (access<2) /* file does not exist, check if read access */ { DFerror = DFE_FNF; /* file not found */ return(NULL); } /*******************************************/ /* issue an open to creat the file and */ /* then immediately close it */ /*******************************************/ #ifdef MAC /* JES 90 */ DF_CLOSE(DF_CREAT(name, 0666)); #else /*MAC*/ /* JES 90 */ #ifdef IBM /* JES 90 */ DF_CLOSE( DF_OPEN( name, DF_CRACCESS ) ); /* JES 90 */ #else /*IBM*/ /* JES 90 */ close (DF_CREAT( name, 0666)); /* else create the file */ #endif /*IBM*/ /* JES 90 */ #endif /*MAC*/ created=1; } /************************************************/ /* else if the file is not being created and */ /* does in fact exist, do this */ /* Note: on non-ibm systems, the fact that the */ /* file exists means it was previously created */ /* for ibm systems, the fact that it does exist */ /* could mean that an empty one was created via */ /* a dd statement as this job was initiated. */ /************************************************/ else { /* JES 90 */ #ifdef IBM /* JES 90 */ /********************************************/ /* dfacc_all means any access including */ /* create or write */ /* for non-ibm systems if dfacc_all is reall*/ /* create, the file wouldnt have been found */ /* and we would have taken care of it above */ /* for ibm systems, an empty one could have */ /* been created via a dd statement, so we */ /* can fall down here even if create was */ /* intended. */ /* in that case, we will know its create */ /* because we wont find the magic bytes */ /********************************************/ if( access == DFACC_ALL ) /* JES 90 */ { /* JES 90 */ char magick??( 4 ??); /* JES 90 */ CKREAD( magick, 4, 1, DFlist??(i??).file, NULL); /* JES 90 */ if ( strncmp(magick,DF_MAGICK,4) ) /* JES 90 */ created = 1; /* JES 90 */ } /* JES 90 */ #endif /*IBM*/ /* JES 90 */ /*******************************************/ /* issue a close to conteract the open */ /* that happened successfully above */ /*******************************************/ DF_CLOSE(DFlist??(i??).file); /* open successful, close it */ } /* JES 90 */ /************************************************/ /* now that the file is created, */ /* open file with correct access mode */ /************************************************/ if ( DF_OPENERR(DFlist??(i??).file = DF_OPEN( name, ((access>1) ? DF_WRACCESS : DF_RDACCESS ))) ) { DFerror = DFE_BADOPEN; return(NULL); } /************************************************/ /* if the file is created, */ /* create the header DDH and DD's */ /************************************************/ . . . /************************************************/ /* if the file exists, check the magic bytes */ /************************************************/ else /* if file already exists */ { char magick??(4??); CKREAD( magick, 4, 1, DFlist??(i??).file, NULL); /* check magick number */ if ( strncmp(magick,DF_MAGICK,4)) { #ifdef IBM /* JES 90 */ if( access == DFACC_ALL ) /* JES 90 */ { /* JES 90 */ #endif /*IBM*/ /* JES 90 */ DFerror = DFE_NOTDFFILE; DF_CLOSE(DFlist??(i??).file); return(NULL); #ifdef IBM /* JES 90 */ } /* JES 90 */ #endif /*IBM*/ /* JES 90 */ } } File DFKIT: DFconvert I reorganized parts of this function to call the IBM to IEEE floating point conversion routines from Cornell. #ifdef FUNC_CONV /* function convert, otherwise, this function is done in macro (dfconvert.h) */ int DFconvert(source, dest, ntype, sourcetype, desttype, size) char *source, *dest; int ntype; register int sourcetype, desttype; int size; { register char t; /* Temporary, used in byte-swapping */ register int i; int status; /********************************************************/ /* this routine only converts floating point numbers */ /********************************************************/ if( ntype == DFNT_FLOAT ) { /********************************************************/ /* treat pc -> ieee and ieee -> pc as a special case */ /********************************************************/ if( ( ( sourcetype == DFNTF_IEEE ) && ( desttype == DFNTF_PC ) ) || ( ( sourcetype == DFNTF_PC ) && ( desttype == DFNTF_IEEE ) ) ) { for( i=0; i=0 && (!isprint(str??(i??)) || !isgraph(str??(i??))); i--) /*EMPTY*/; #else /* IBM */ /* END JES 90 */ for(i=len-1;i>=0 && (!isascii(str??(i??)) || !isgraph(str??(i??))); i--) /*EMPTY*/; #endif /* IBM */ /* JES 90 */ cstr = DFIgetspace(i+2); cstr??(i+1??) = '\0'; for (; i>=0; i--) cstr??(i??) = str??(i??); return cstr; } cfi32s and cfsi32 I got these routines from Cornell. They were set up to convert arrays of numbers. HDF 2.37 called with 1 number at a time so I unlooped these. I also found a bug that caused incorrect conversion. HDF 3.1 calls with arrays so I looped these again. /* ------------------------------------------------------------------ * procedure: cfi32s(float ief, float ibf) * ------------------------------------------------------------------- * Convert floating point, IEEE 32-bit to IBM 32-bit, i.e float * * input: ief Array of 32-bit IEEE floating point numbers, * single precision. * nf Number of elements in ief to convert, integer. * output: ibf Array of IBM floating point numbers, float values * Can be located at the same space as ief. * * Format (bits, left to right): | Exponent bias: * sign exponent mantissa | * IBM 1 7 24 | 64 dec or 40 hex * IEEE 1 8 23 | 127 * | * Usage notes: * 1. Infinite IEEE values are converted to the largest IBM values. * 2. NaN (Not a Number) values are converted to the largest values * like infinities. * 3. Denormalized and zero values are kept intact (they are * analogous in both IEEE and IBM standards. * 4. Precision in the mantissa could be lost by rounding off the * least significant bits. 0 <= |error| <= 0.24E-6 * (From 0 to 3 least significant bits out of 24 mantissa bits * could be rounded.) * ------------------------------------------------------------------- * PROCESSOR - C, AIX * * LIBRARY - NONE * * DEPENDENCES - NONE * * ENTRY POINT - cfi32s * * ERRORS - NOT FOUND * * 06/16/89 Valery I. Garger, Technology Integration * Group, CNSF, Cornell University * 01/02/90 Adapted for HDF by jes (Joan Slottow ) * UCLA - OAC * ------------------------------------------------------------------- * Change log: No. * ------------------------------------------------------------------- */ #define last 0x000000ff #define impl 0x00800000 #define sign 0x80000000 #define tiss 0x007fffff int cfi32s( ieee, ibm, size ) /* JES 90 */ int32 ieee??( ??), ibm??( ??), size; /* JES 90 */ { int32 j, k, ibmsign, ibmexp, ibmfrac; /* JES 90 */ for( j = 0; j < size; j++ ) { ibmfrac = ieee??( j ??); ibmsign = ieee??( j ??) & sign; ibmexp = ( ieee??( j ??) >> 23 ) & last; if( ibmexp != 0 ) { if( ibmexp == 255 ) { ibmexp = 378; ibmfrac = tiss; } ibmexp = ibmexp - 127 + 256 +1; k = ibmexp%4; ibmexp = ibmexp/4; if( k != 0 ) ibmexp = ibmexp + 1; ibmexp = ibmexp << 24 ; ibmfrac = (ibmfrac & tiss) | impl ; if (k != 0) ibmfrac = ( ibmfrac + (1 << (3-k) ) ) >> (4-k); } ibm??( j ??) = ibmsign | ibmexp | ibmfrac; } return(0); /* JES 90 */ } /* ------------------------------------------------------------------ * procedure: cfsi32(float ibmfp,float ieeefp) * ------------------------------------------------------------------- * PROCESSOR - C, AIX * * LIBRARY - NONE * * DEPENDENCES - NONE * * ENTRY POINT - cfsi32 * * ERRORS - NOT FOUND * * 06/16/89 Valery I. Garger, Technology Integration * Group, CNSF, Cornell University * 01/02/90 put into HDF by Joan Slottow (jes) UCLA-OAC *-------------------------------------------------------------------- * Change log: No. * ------------------------------------------------------------------- * Convert floating point, 32-bit IBM to 32-bit IEEE standard. * * input: ibmfp Array of IBM floating point numbers, float values. * nf Number of elements in ibmfp to convert, int. * output: ieeefp Array of 32-bit IEEE floating point numbers. * * Format (bits, left to right): | Exponent bias: * sign exponent mantissa | * IBM 1 7 24 | 64 dec or 40 hex * IEEE 1 8 23 | 127 * | * Usage notes: * 1. IBM values that do not conform to IEEE standard (because IBM * standard can express larger and smaller values than IEEE ) * are converted to either infinite IEEE values (positive or * negative) or to zero. * 2. Denormalized and zero values are kept intact (they are * analogous in both IEEE and IBM standards. * 3. Conversion does not incur the lost of mantissa accuracy. * ------------------------------------------------------------------- */ #define exp 0x7F000000 #define sign 0x80000000 #define tis 0x00FFFFFF #define etis 0x007FFFFF int cfsi32( ibm, ieee, size ) /* JES 90 */ int32 ibm??( ??), ieee??( ??), size; /* JES 90 */ { int32 j, ibmsign, ibmexp, ibmfrac, it, k; /* JES 90 */ for( j = 0; j < size; j++ ) { ibmsign = ibm??( j ??) & sign; ibmexp = ibm??( j ??) & exp; ibmfrac = ibm??( j ??) & tis; it = ibmfrac << 8; for(k = 0; (k < 5) && (it >= 0); k++ ) it = it << 1; if( k < 4 ) { ibmfrac = (it >> 8) & etis; ibmexp = (ibmexp >> 22) - 256 + 127 - k - 1; if( ibmexp < 0 ) ibmexp = ibmfrac = 0; if( ibmexp >= 255 ) { ibmexp = 255; ibmfrac = 0; } ibmexp = ibmexp << 23; } ieee??( j ??) = ibmsign | ibmexp | ibmfrac; } return(0); /* JES 90 */ } DFCVa2eC and DFCVe2aC I added these routines to do ASCII/EBCDIC conversions. /*********************************************************/ /* Name: DFCVa2eC */ /* added by JES 89 */ /* ASCII to EBCDIC conversion routine */ /* DFCVa2eC( string, len ) */ /* string = ASCII character string */ /* len = # of characters in string */ /*********************************************************/ int DFCVa2eC( string, len ) char string??( ??); int len; { int i; static char ebcdic??( 128 ??) = { 0x00, 0x01, 0x02, 0x03, 0x37, 0x2d, 0x2e, 0x2f, 0x16, 0x05, 0x25, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x3c, 0x3d, 0x32, 0x26, 0x18, 0x19, 0x3f, 0x27, 0x22, 0x28, 0x35, 0x29, 0x40, 0x5a, 0x7f, 0x7b, 0x5b, 0x6c, 0x50, 0x7d, 0x4d, 0x5d, 0x5c, 0x4e, 0x6b, 0x60, 0x4b, 0x61, 0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7, 0xf8, 0xf9, 0x7a, 0x5e, 0x4c, 0x7e, 0x6e, 0x6f, 0x7c, 0xc1, 0xc2, 0xc3, 0xc4, 0xc5, 0xc6, 0xc7, 0xc8, 0xc9, 0xd1, 0xd2, 0xd3, 0xd4, 0xd5, 0xd6, 0xd7, 0xd8, 0xd9, 0xe2, 0xe3, 0xe4, 0xe5, 0xe6, 0xe7, 0xe8, 0xe9, 0xad, 0xe0, 0xbd, 0x5f, 0x6d, 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7, 0xa8, 0xa9, 0x8b, 0x6a, 0x9b, 0xa1, 0x07, } ; for(i = 0; i < len; i++ ) string??( i ??) = ebcdic??( ( uint16 )string??( i ??) ??); return( 0 ); } /*********************************************************/ /* Name: DFCVe2aC */ /* added by jes 89 */ /* EBCDIC to ASCII conversion routine */ /* DFCVe2aC( string, len ) */ /* string = ASCII character string */ /* len = # of characters in string */ /*********************************************************/ int DFCVe2aC( string, len ) char string??( ??); int len; { int i; static char ascii??( 256 ??) = { 0x00, 0x01, 0x02, 0x03, 0x20, 0x09, 0x20, 0x7f, 0x20, 0x20, 0x20, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x20, 0x20, 0x08, 0x20, 0x18, 0x19, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x1c, 0x13, 0x20, 0x0a, 0x17, 0x1b, 0x1d, 0x1f, 0x20, 0x20, 0x20, 0x05, 0x06, 0x07, 0x20, 0x20, 0x16, 0x20, 0x20, 0x1e, 0x20, 0x04, 0x20, 0x20, 0x20, 0x20, 0x14, 0x15, 0x20, 0x1a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x5b, 0x2e, 0x3c, 0x28, 0x2b, 0x7c, 0x26, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x21, 0x24, 0x2a, 0x29, 0x3b, 0x5e, 0x2d, 0x2f, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x7c, 0x2c, 0x25, 0x5f, 0x3e, 0x3f, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x60, 0x3a, 0x23, 0x40, 0x27, 0x3d, 0x22, 0x20, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x20, 0x7b, 0x20, 0x20, 0x20, 0x5c, 0x20, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f, 0x70, 0x71, 0x72, 0x20, 0x7d, 0x20, 0x20, 0x20, 0x20, 0x20, 0x7e, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7a, 0x20, 0x20, 0x20, 0x5b, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x5d, 0x20, 0x20, 0x7b, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x7d, 0x4a, 0x4b, 0x4b, 0x4d, 0x4e, 0x4f, 0x50, 0x51, 0x52, 0x20, 0x20, 0x20, 0x20, 0x20, 0x00, 0x5c, 0x20, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5a, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x20, 0x20, 0x20, 0x20, 0x20, 0x20 } ; for( i = 0; i < len; i++ ) string??( i ??) = ascii??( ( uint16 )string??( i ??) ??); return( 0 ); } There are different ASCII translate tables used by different parts of the system here at UCLA. There are some historical choices made so that people could program in PL/I from ASCII terminals. They include: backslash translates to cent sign tilde and hat translate to not sign split bar translates to or bar Also, IBM has two sets of squigly brackets: the printing set and the keyboard set and they have different hex values. Following are some characters that translate differently in different translate tables. All numbers are in hex. ASCII | EBCDIC | 13 (DC3) | 13 DC1 | 23 WUS | 1C (FS) | 1C IFS | 22 FS | 1D (GS) | 1D IGS | 28 SA | 1E (RS) | 1E IRS | 35 TRN | 1F (US) | 1F US | 29 SFE | 21 (!) | 4F or bar | 5A ! | 5B (open square bracket) | 4A cent sign | AD open square bracket | 5C (backslash) | E0 back slash | 4A cent sign | 8F nothing | 5D (close square bracket) | 5A ! | BD close square bracket | 5E (hat) | 5F not sign | 71 nothing | 4F or bar | 7B (open squigly bracket) | C0 open squigly bracket | 8B different open squigly | 7C (split bar) | 6A split bar | 4F or bar | 7D (close squigly bracket) | D0 close squigly bracket | 9B different close squigly | 7E (tilde) | A1 tilde | 5F not sign ASCII translate table I put into HDF: ASCII EBCDIC VALUE IN HDF 13 (DC3) 23 (WUS) 1C (FS) 22 (FS) 1D (GS) 28 (SA) 1E (RS) 35 (TRN) 1F (US) 29 (SFE) 21 (!) 5A (!) 5B (open square bracket) 4A (open square bracket) 5C (back slask) E0 (back slash) 5D (close square bracket) BD (close square bracket) 5E (hat) 5F (not sign) 7B (open squigly bracket) 8b (printable open squigly) 7C (split bar) 6A (split bar) 7D (close squigly bracket)9b (printable close squigly) 7E (tilde) 5F (not sign) Text is translated to ASCII whenever it is put into and HDF file and into EBCDIC whenever it is takes from an HDF file. This includes annotation and the labeling of scientific data. If your installation does not like any of the translation choices that I made, you can change them. File DFSD: I had to change the names of routines and references to internal routines. I did this physically in the file as follows: #ifdef IBM /* JES 90 */ int dsIputslice(windims, data, dims, isfortran) /* JES 90 */ #else /* JES 90 */ int DFSDIputslice(windims, data, dims, isfortran) #endif /* JES 90 */ For all other sets of routines I used the #pragma map statement to accomplish this same thing. When I started on the DFSD's I was unaware of the #pragma map statement. DFSDgetdimstrs I had to comment out the following code because the compiler didn't like it. By doing so I effectively deleted a test for an error condition. The IBM C/370 compiler complained that the syntax was was illegal because you can only negate a scalar. /****************** JES 90 ***************************** if (!Readsdg.dimluf) { *lufp = '\0'; continue; } **** IBM's C compiler complains that the above is a pointer to a **** pointer and that it can only negate a scalar ***************/ DFSDgetsdg I added these variables: int charlen; /* JES 90 */ uint16 userCT, fileCT; /* JES 90 */ And set the user's character type and file's character type: userNT = (DF_MT>>8) & 0x0f; /* get third nibble from right */ userCT = DF_MT & 0x000f; /* get machine character type */ /* JES 90 */ fileCT = DFNTC_ASCII; /* file character type is always ASCII */ /*JES 90*/ And saved the length of a character string in charlen: /* read in luf */ /* if (DFgetelement(dfile, elmt.tag, elmt.ref, buf)<0) { JES 90 */ charlen = DFgetelement( dfile, elmt.tag, elmt.ref, buf );/* JES 90 */ if( charlen < 0 ) /* JES 90 */ { buf = DFIfreespace(buf); return(-1); } Character strings are saved in the file for things like the title of the file, the x-axis title, the y-axis title, the formats, units, etc. /***********************************************************/ /* do ascii to ebcdic conversion if necessary JES 90 */ /***********************************************************/ if( fileCT == DFNTC_ASCII && userCT == DFNTC_EBCDIC ) /* JES 90 */ DFCVa2eC( buf,charlen ); /* JES 90 */ else if( fileCT == DFNTC_EBCDIC && /* JES 90 */ userCT == DFNTC_ASCII ) /* JES 90 */ DFCVe2aC( buf,charlen ); /* JES 90 */ /* read coordsys */ /* if (DFgetelement(dfile, elmt.tag, elmt.ref, JES 90 */ /* sdg->coordsys ) < 0) JES 90 */ charlen = DFgetelement(dfile, elmt.tag, elmt.ref, /* JES 90 */ sdg->coordsys ); /* JES 90 */ if( charlen < 0 ) /* JES 90 */ return(-1); /***********************************************************/ /* do ascii to ebcdic conversion if necessary JES 90 */ /***********************************************************/ if( fileCT == DFNTC_ASCII && userCT == DFNTC_EBCDIC ) /* JES 90 */ DFCVa2eC( sdg->coordsys,charlen ); /* JES 90 */ else if( fileCT == DFNTC_EBCDIC && /* JES 90 */ userCT == DFNTC_ASCII ) /* JES 90 */ DFCVe2aC( sdg->coordsys,charlen ); /* JES 90 */ break; DFSDputsdg This routine writes the scientific data group into the file from the structures. I define the same new variables and set them. And call the ASCII/EBCDIC etc. conversion routines if necessary. localNT = (DF_MT>>8) & 0x0f; /* get third nibble from right */ userCT = DF_MT & 0x000f; /* get machine character type */ /* JES 90 */ fileCT = DFNTC_ASCII; /* file character type is always ASCII */ /* JES 90 */ /* write dimension tag/ref */ if( DFdiput( DFTAG_SDD,(uint16) Ref.dims ) < 0 ) return(-1); /*******************************************************/ /* write out label/unit/format */ /*******************************************************/ for (luf=LABEL; luf<=FORMAT; luf++) { luftag = (luf==LABEL) ? DFTAG_SDL : (luf==UNIT) ? DFTAG_SDU : DFTAG_SDF; /************************************************************/ /* this block of code checks if luf is NULL, else writes it */ /************************************************************/ if (!Ref.luf??(luf??)) { /* if luf was set */ Ref.luf??(luf??) = -1; /* assume it is NULL */ /********************************************************/ /* do this once for each rank */ /********************************************************/ for (i=0; irank; i++) { /****************************************************/ /* if luf is non-NULL set up to write */ /****************************************************/ if( ( sdg->dataluf??(luf??) && sdg->dataluf??(luf??)??(0??) ) || ( sdg->dimluf??(luf??) && sdg->dimluf??(luf??)??(i??) && sdg->dimluf??(luf??)??(i??)??(0??) ) ) { if (DFaccess(dfile, luftag, ref, "w")<0) return(-1); /*******************************************/ /* write data luf */ /*******************************************/ /* JES 90 */ /*******************************************/ /* JES 90 */ /* if the data is in EBCDIC, convert it */ /* JES 90 */ /* to ASCII before writing it out */ /* JES 90 */ /*******************************************/ /* JES 90 */ if( userCT == DFNTC_EBCDIC && /* JES 90 */ fileCT == DFNTC_ASCII ) /* JES 90 */ { /* JES 90 */ /*********************************************/ /* JES 90 */ /* allocate buf, copy the ebcdic string to it*/ /* JES 90 */ /* and convert to ascii */ /* JES 90 */ /*********************************************/ /* JES 90 */ if( sdg->dataluf??( luf ??) ) /* JES 90 */ { /* JES 90 */ charlen = strlen( sdg -> dataluf??( luf ??) ); /* JES 90 */ buf = DFIgetspace( ( unsigned )( charlen+1 ) ); /* JES 90 */ if( buf==NULL ) /* JES 90 */ return(-1); /* JES 90 */ strcpy( buf, sdg -> dataluf??( luf ??) ); /* JES 90 */ DFCVe2aC( buf, charlen ); /* JES 90 */ } /* JES 90 */ else /* JES 90 */ { /* JES 90 */ charlen = 0; /* JES 90 */ buf = DFIgetspace( ( unsigned )( charlen+1 ) ); /* JES 90 */ if( buf==NULL ) /* JES 90 */ return(-1); /* JES 90 */ buf??( 0 ??) = '\0'; /* JES 90 */ } /* JES 90 */ /*********************************************/ /* JES 90 */ /* now write it out */ /* JES 90 */ /*********************************************/ /* JES 90 */ if( DFwrite( dfile, buf, charlen+1 ) < 0 ) /* JES 90 */ return( -1 ); /* JES 90 */ buf = DFIfreespace( buf ); /* JES 90 */ } /* JES 90 */ /*******************************************/ /* JES 90 */ /* if the data is already in ASCII, */ /* JES 90 */ /* just write it out */ /* JES 90 */ /*******************************************/ /* JES 90 */ else /* JES 90 */ { if (sdg->dataluf??(luf??)) { if( DFwrite( dfile, sdg->dataluf??(luf??), ( int32 )strlen( sdg->dataluf??(luf??))+1 ) < 0 ) return(-1); } else { /* write NULL */ if (DFwrite(dfile, "", (int32) 1)<0) return(-1); } /* JES 90 */ } /*******************************************/ /* write dim lufs */ /*******************************************/ for( j=0; jrank; j++ ) /* JES 90 */ { /* JES 90 */ /*******************************************/ /* JES 90 */ /* if the data is in EBCDIC, convert it */ /* JES 90 */ /* to ASCII before writing it out */ /* JES 90 */ /*******************************************/ /* JES 90 */ if( userCT == DFNTC_EBCDIC && /* JES 90 */ fileCT == DFNTC_ASCII ) /* JES 90 */ { /* JES 90 */ /*****************************************/ /* JES 90 */ /* allocate buf, copy the ebcdic string */ /* JES 90 */ /* to it and convert to ascii */ /* JES 90 */ /*****************************************/ /* JES 90 */ if( sdg->dimluf??(luf??) && /* JES 90 */ sdg->dimluf??(luf??)??(j??) ) /* JES 90 */ { /* JES 90 */ charlen = /* JES 90 */ strlen( sdg -> dimluf??(luf??)??(j??) ); /* JES 90 */ buf = DFIgetspace( (unsigned)(charlen+1) ); /* JES 90 */ if( buf==NULL ) /* JES 90 */ return(-1); /* JES 90 */ strcpy( buf, sdg -> dimluf??(luf??)??(j??) ); /* JES 90 */ DFCVe2aC( buf, charlen ); /* JES 90 */ } /* JES 90 */ else /* JES 90 */ { /* JES 90 */ charlen = 0; /* JES 90 */ buf = /* JES 90 */ DFIgetspace( ( unsigned )( charlen+1 ) ); /* JES 90 */ if( buf==NULL ) /* JES 90 */ return(-1); /* JES 90 */ buf??( 0 ??) = '\0'; /* JES 90 */ } /* JES 90 */ /*****************************************/ /* JES 90 */ /* now write it out */ /* JES 90 */ /*****************************************/ /* JES 90 */ if( DFwrite( dfile, buf, charlen+1 ) < 0 ) /* JES 90 */ return( -1 ); /* JES 90 */ buf = DFIfreespace( buf ); /* JES 90 */ } /* JES 90 */ /*******************************************/ /* JES 90 */ /* if the data is already in ASCII, */ /* JES 90 */ /* just write it out */ /* JES 90 */ /*******************************************/ /* JES 90 */ else /* JES 90 */ { if( sdg->dimluf??(luf??) && sdg->dimluf??(luf??)??(j??) ) { if (DFwrite(dfile, sdg->dimluf??(luf??)??(j??), (int32) strlen( sdg->dimluf??(luf??)??(j??))+1) < 0 ) return(-1); } else { /* write NULL */ if (DFwrite(dfile, "", (int32) 1)<0) return(-1); } /* JES 90 */ } /* JES 90 */ } Ref.luf??(luf??) = ref; /* remember ref */ break; } } } /*******************************************************/ /* write out coordsys */ /*******************************************************/ if( !sdg->coordsys || !sdg->coordsys??(0??) ) Ref.coordsys = (-1); if (!Ref.coordsys) { /*******************************************/ /* JES 90 */ /* if the data is in EBCDIC, convert it */ /* JES 90 */ /* to ASCII before writing it out */ /* JES 90 */ /*******************************************/ /* JES 90 */ if( userCT == DFNTC_EBCDIC && /* JES 90 */ fileCT == DFNTC_ASCII ) /* JES 90 */ { /* JES 90 */ /*********************************************/ /* JES 90 */ /* allocate buf, copy the ebcdic string to it*/ /* JES 90 */ /* and convert to ascii */ /* JES 90 */ /*********************************************/ /* JES 90 */ charlen = strlen( sdg -> coordsys ); /* JES 90 */ buf = DFIgetspace( ( unsigned )( charlen+1 ) ); /* JES 90 */ if( buf==NULL ) /* JES 90 */ return(-1); /* JES 90 */ strcpy( buf, sdg -> coordsys ); /* JES 90 */ DFCVe2aC( buf, charlen ); /* JES 90 */ /*********************************************/ /* JES 90 */ /* now write it out */ /* JES 90 */ /*********************************************/ /* JES 90 */ if( DFputelement( dfile, DFTAG_SDC, ref, buf, /* JES 90 */ ( int32 )(charlen+1) ) < 0 ) /* JES 90 */ return( -1 ); /* JES 90 */ buf = DFIfreespace( buf ); /* JES 90 */ } /* JES 90 */ /*******************************************/ /* JES 90 */ /* if the data is already in ASCII, */ /* JES 90 */ /* just write it out */ /* JES 90 */ /*******************************************/ /* JES 90 */ else /* JES 90 */ { /* JES 90 */ if( DFputelement( dfile, DFTAG_SDC, ref, sdg->coordsys, (int32) (strlen(sdg->coordsys)+1 ) ) < 0 ) return(-1); } /* JES 90 */ Ref.coordsys = ref; } File DFAN: I added the code to do the appropriate ASCII/EBCDIC conversion. DFANIgetann: uint16 userCT, fileCT; /* JES 90 */ /*************************************************************/ /* Convert to EBCDIC if on an EBCDIC machine */ /*************************************************************/ userCT = DF_MT & 0x000f; /* char type of user's machine */ /* JES 90 */ fileCT = DFNTC_ASCII; /* file char type is always ASCII */ /* JES 90 */ if( fileCT == DFNTC_ASCII && userCT == DFNTC_EBCDIC ) /* JES 90 */ DFCVa2eC( ann, annlen ); /* JES 90 */ DFANIputann: uint16 userCT, fileCT; /* JES 90 */ char *buf; /* JES 90 */ /*************************************************************/ /* Convert to ASCII if on an EBCDIC machine */ /* use a temporary for the ASCII */ /*************************************************************/ userCT = DF_MT & 0x000f; /* char type of user's machine */ /* JES 90 */ fileCT = DFNTC_ASCII; /* file char type is always ASCII */ /* JES 90 */ if( userCT == DFNTC_EBCDIC && fileCT == DFNTC_ASCII ) /* JES 90 */ { /* JES 90 */ buf = DFIgetspace( ( unsigned )annlen ); /* JES 90 */ if( buf == NULL ) /* JES 90 */ return( -1 ); /* JES 90 */ strncpy( buf, ann, annlen ); /* JES 90 */ DFCVe2aC( buf, annlen ); /* JES 90 */ ret = DFwrite(dfile, buf, annlen); /* JES 90 */ buf = DFIfreespace( buf ); /* JES 90 */ } /* JES 90 */ else /* JES 90 */ ret = DFwrite(dfile, ann, annlen); DFANIlablist: uint16 userCT, fileCT; /* JES 90 */ userCT = DF_MT & 0x000f; /* char type of user's machine */ /* JES 90 */ fileCT = DFNTC_ASCII; /* file char type is always ASCII */ /* JES 90 */ /*************************************************************/ /* Convert to EBCDIC if on an EBCDIC machine */ /*************************************************************/ if( fileCT == DFNTC_ASCII && userCT == DFNTC_EBCDIC ) /* JES 90 */ DFCVa2eC( lp, ret ); /* JES 90 */ DFANIaddfann: uint16 userCT, fileCT; /* JES 90 */ char *buf; /* JES 90 */ /*************************************************************/ /* Convert to ASCII if on an EBCDIC machine */ /* use a temporary for the ASCII */ /*************************************************************/ userCT = DF_MT & 0x000f; /* char type of user's machine */ /* JES 90 */ fileCT = DFNTC_ASCII; /* file char type is always ASCII */ /* JES 90 */ if( userCT == DFNTC_EBCDIC && fileCT == DFNTC_ASCII ) /* JES 90 */ { /* JES 90 */ buf = DFIgetspace( ( unsigned )annlen ); /* JES 90 */ if( buf == NULL ) /* JES 90 */ return( -1 ); /* JES 90 */ strncpy( buf, ann, annlen ); /* JES 90 */ DFCVe2aC( buf, annlen ); /* JES 90 */ if( DFputelement(dfile, anntag, annref, buf, annlen) < 0 ) /* JES 90 */ { /* JES 90 */ buf = DFIfreespace( buf ); /* JES 90 */ return(-1); /* JES 90 */ } /* JES 90 */ } /* JES 90 */ else /* JES 90 */ if (DFputelement(dfile, anntag, annref, ann, annlen)<0) DFANIgetfann: uint16 userCT, fileCT; /* JES 90 */ /*************************************************************/ /* Convert to EBCDIC if on an EBCDIC machine */ /*************************************************************/ userCT = DF_MT & 0x000f; /* char type of user's machine */ /* JES 90 */ fileCT = DFNTC_ASCII; /* file char type is always ASCII */ /* JES 90 */ if( fileCT == DFNTC_ASCII && userCT == DFNTC_EBCDIC ) /* JES 90 */ DFCVa2eC( ann, length ); /* JES 90 */ I also created JCL files for installing 12 load modules. The load module names ending in F are for use by FORTRAN. The others are for use by C. All load modules are partial loadmodules and have to be re-linkedited with the user's program. Using partial load modules allows the user to mix and match components. The DF (C) or DFF (FORTRAN) load module is always required. Currently, you cannot make a load module that includes both DFR8 and DFSD (or DFR8F and DFSDF). This is because DFR8 and DFSD both use some of the same global variables but they are initialized differently.