/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:30:54 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "optchk.h" #include #include #include /* PARAMETER translations */ #define LTXTAB 9 #define LTXTAC 233 #define LTXTAD 267 #define MECONT 50 #define MEEMES 52 #define MEIDAT 24 #define MEIMAT 58 #define MENTXT 23 #define MERET 51 #define METEXT 53 /* end of PARAMETER translations */ void /*FUNCTION*/ optchk( long intchk[], long iopt[], char *etext) { long int errbad, i, istrt, kex, l, last, lneg, lopt, lwant, mi, mv, n; static char mtxtaa[2][157]={"OPTCHK$B\"Option #\" is negated if option needs attention.$N\"Option 0\" is for space not associated with a specific option.$N\"First Loc.\" is negated if user di", "d not set value.$NSpace avail. = $I; all options must have first loc. > $I$EOption #$HFirst$ Loc.$HLast Loc.$EFrom subprogram/argument: $BSpace for ETEXT.$E"}; static long mact[16]={MEEMES,0,1,LTXTAD,MEIDAT,2,MENTXT,LTXTAB, METEXT,MEIMAT,3,3,0,LTXTAC,-1,MERET}; static long nerbad[7-(0)+1]={57,17,57,17,0,0,7,7}; /* OFFSET Vectors w/subscript range: 1 to dimension */ long *const Iopt = &iopt[0] - 1; long *const Mact = &mact[0] - 1; /* end of OFFSET VECTORS */ /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 1998-11-01 OPTCHK Krogh ERRSEV => MACT(2) for "mangle". *>> 1996-05-13 OPTCHK Krogh Changes to use .C. and C%%. *>> 1995-03-10 OPTCHK Krogh Added "abs(.) just below "do 140 ..." *>> 1994-11-11 OPTCHK Krogh Declared all vars. *>> 1993-05-17 OPTCHK Krogh Additions for Conversion to C. *>> 1991-11-25 OPTCHK Krogh More comments, little clean up of code. *>> 1991-10-09 OPTCHK Krogh More comments, little clean up of code. *>> 1991-06-27 OPTCHK Krogh Initial Code. * * OPTCHK -- Fred T. Krogh, Jet Propulsion Lab., Pasadena, CA. * This subroutine is intended for the use of other library routines. * It is used to check the storage used by options for some array. * * INTCHK is an array that provides information on how storage has been * allocated. Information is provided in groups of three words, after * an initial group of 4 that contain: * 0. INTCHK(0) / 10 is the index to use for error messages, and * mod(INTCHK(0), 10) defines actions as follows: * Value Action on Errors Action if no errors * 0 Prints & Stops Returns * 1 Prints & Returns Returns * 2 Prints & Stops Prints & Returns * 3 Prints & Returns Prints & Returns * >3 Any error message will be continued, subtract 4 from the * value to get one of the actions above. * 1. Contains LAST, 1 more than the index of the last location in * INTCHK used to store the information as described below. * 2. The amount of storage available in the array being checked. If * this is 0, it is assumed that the user would like to know what * size to declare for the array, and if it is -1, it is assumed * that a library routine is doing the check without knowing what * the declared size is. * 3. The amount of storage required in this array if no options were * used. (This + 1 is first loc. available for option storage.) * The rest should be set as follows, for k = 5, LAST, 3: * k-1 Option index, 0 indicates storage required by default. (This * may depend on input parameters, but doesn't depend explicitly * on an option.) * k If >0, gives the start of space used by the option. * If <0, gives -(amount of space required by an option), for * which a starting location is to be determined. * k+1 If preceding entry is >0, gives space required by the option. * Else it is assumed that the space requested is to be found, * and a diagnostic will be given if space can not be found. Else * INTCHK(K+1) IOPT(INTCHK(k+1)) Diagnostic on successful alloc.? * 0 ---- No * <0 ---- Yes * >0 .ne. -1 Yes * >0 .eq. -1 No, and IOPT(INTCHK(k+1)) is set * to starting loc. of space found. * When this program finds the space for an option, values of * INTCHK(j) for j .ge. LAST will be used. INTCHK(k+1) is set * temporarily to -(space required) and INTCHK(k-1) is reduced by * 2000000 to flag the fact that the location index must be saved * after INTCHK(LAST). INTCHK(LAST) is assumed to contain 1 if * the largest space requested is required, and to contain * -(minimal space needed) if the large amount requested is not * essential. * On exit, INTCHK(1) is set = -LAST if there was some kind of error. * (Unless the user has called MESS this return can't happen.) * INTCHK(2) is set to suggest a value for the storage to be declared. * The remaining locations are changed as follows: * k-1 Negated if there was a problem with this option, or if the * following location was initially <0. * k Starting location used or suggested for the option. * k+1 Last location used or suggested for the option. * * In addition if values of INTCHK(j) for j .ge. LAST are used, * INTCHK(j), for j = LAST+1, LAST+2, ..., will be set so that * INTCHK(j) is equal to (one of the k's above) - 1 for an option * that has had a starting location assigned, and INTCHK(LAST) is * set to the last index value for j in the above list. * * IOPT This is stored to if INTCHK(k) is < 0, see above. * ETEXT Input text of the form 'Package_name / Argument_name$E'. Thus * for argument KORD of the package DIVA, this would = 'DIVA / KORD$E'. * * ************************** Variable definitions ********************** * * ERRBAD Flag to use for error severity if get an error. 17 if errors * are to print but not stop, 57 otherwise. * ETEXT (Input) Used to construct error messages, see above. * I Induction variable for accessing INTCHK(). * INTCHK (InOut) See above. * IOPT (Out) If space information is being obtained results are saved * here. See above. * ISTRT Starting index for placing options with unknown locations. * KEX Points to the last place in INTCHK where indices of entries * that have had locations determined here are stored. * L Temporary index. * LAST First free location in INTCHK. (=INTCHK(1)) * LNEG Index of the first INTCHK entry that is to be positioned. * LOPT Location in IOPT to get location of INTCHK entry that is * positioned. * LTXTAx Variables setup by PMESS defining the locations in MTXTAA where * various error messages start. * LTXTEE Location in MTXTAA where data in ETEXT is stored. */ /* LTXTZZ Number of characters available for saving ETEXT in MTXTAA. * LWANT -Number of locations wanted by INTCHK entry being positioned. * MACT Vector used to specify error printing actions, see MESS. * MACT(2) flags error/diagnostic level. = 0 none; 07 is used to * get diagnostics only; and ERRBAD otherwise. * MEEMES Parameter specifying that error message is to be printed. * MEIDAT Parameter specifying location in INTCHK to start printing * integer in MESS. * MEIMAT Parameter specifying an integer matrix is to be printed. * MENTXT Parameter specifying location in INTCHK to start printing * text from MTXTAA in MESS. * MERET Parameter specifying the end of an error message. * MESS Routine to print error and diagnostc messages. * METEXT Parameter specifying that text is to be printed. * MI Temporary index used to save in acceptable location. * MTXTAA Used to contain error message text and instructions, see MESS. * MTXTAx Character variables setup by PMESS and equivalenced into ETEXT * used to contain parts of the error messages. * MTXTZZ As for MTXTAx, except not setup by PMESS. Used to hold text * from ETEXT. * MV Temporary, which contains value associated with INTCHK(MI). * N Temporary value. * NERBAD Array telling what to do concerning errrors. ERRBAD is set * from NERBAD(mod(INTCHK(0), 10)), and the default value for * MACT(2) is set from NERBAD(INTCHK(0)+4). * * ************************** Variable Declarations ********************* * */ /* Declarations for error messages. */ /* ********* Error message text *************** *[Last 2 letters of Param. name] [Text generating message.] *AA OPTCHK$B *AB "Option #" is negated if option needs attention.$N * "Option 0" is for space not associated with a specific option.$N * "First Loc." is negated if user did not set value.$N * Space avail. = $I; all options must have first loc. > $I$E *AC Option #$HFirst Loc.$HLast Loc.$E *AD From subprogram/argument: $B *AE Space for ETEXT.$E */ /* Next 4 lines not automatically generated */ #define LTXTEE 137 /* parameter (LTXTEE = LTXTAE - 156 - 2) * */ /* 1 2 3 4 5 6 7 8 9 */ /* 10 13 14 15 16 */ /* *************************** Start of Executable Code ***************** * */ Mact[3] = intchk[0]/10; Mact[16] = MERET; i = intchk[0] - 10*Mact[3]; if (i > 3) { i -= 4; Mact[16] = MECONT; } errbad = nerbad[i]; Mact[2] = nerbad[i + 4]; last = intchk[1]; kex = last; L_20: lneg = 0; for (i = 5; i <= last; i += 3) { /* Loop to sort on the low indices -- Inefficient algorithm to keep * code short -- LAST should never be very big. */ mi = i; mv = intchk[i]; for (l = i + 3; l <= last; l += 3) { /* Find mimimum from here down. */ if (intchk[l] < mv) { mi = l; mv = intchk[l]; } } if (mi != i) { /* Interchange to get low at top. */ for (l = -1; l <= 1; l++) { n = intchk[i + l]; intchk[i + l] = intchk[mi + l]; intchk[mi + l] = n; } } if (mv < 0) { /* Save loc. of last entry that needs space to be found. */ lneg = i; } else if (lneg == 0) { /* Entry I and previous entries are in their correct sorted order. */ if (intchk[i + 1] < 0) { if (intchk[i - 1] < -1000000) { intchk[i - 1] += 2000000; intchk[i + 1] = -intchk[i + 1]; /* Save INTCHK index defining allocated space. */ kex += 1; intchk[kex] = i - 1; } else { /* Error -- Got request for a negative amount of space. */ Mact[2] = errbad; intchk[i - 1] = -labs( intchk[i - 1] ); } } /* Save final location used by the option. */ intchk[i + 1] += intchk[i] - 1; if (intchk[i] <= intchk[i - 2]) { /* Error -- options overlap. */ intchk[i - 1] = -labs( intchk[i - 1] ); Mact[2] = errbad; } } } if (lneg != 0) { /* Find spaces that need to be allocated, starting with the smallest. */ istrt = lneg; i = lneg; L_120: lwant = intchk[lneg]; lopt = intchk[lneg + 1]; if (i == lneg) { /* Make fake entry to get started. */ intchk[lneg] = 1; intchk[lneg + 1] = intchk[3]; } for (istrt = istrt; istrt <= (last - 3); istrt += 3) { if (intchk[i] + labs( intchk[i + 1] ) - lwant < intchk[istrt + 3]) goto L_150; i = istrt + 3; } L_150: intchk[lneg] = intchk[i] + labs( intchk[i + 1] ); if (lopt != 0) { if (lopt > 0) { if (Iopt[lopt] == -1) { Iopt[lopt] = intchk[lneg]; goto L_160; } } /* Error -- IOPT not expecting starting loc. */ intchk[lneg - 1] = -labs( intchk[lneg - 1] ); Mact[2] = errbad; } L_160: intchk[lneg + 1] = lwant; intchk[lneg - 1] -= 2000000; if (lneg < 8) goto L_20; i = lneg; lneg -= 3; goto L_120; } if (intchk[last - 1] > intchk[2]) { if (intchk[2] < 0) goto L_180; if (last != kex) { if (intchk[kex] == last - 3) { if (intchk[last] <= 0) { if (intchk[last - 2] - intchk[last] - 1 <= intchk[2]) { intchk[last - 1] = intchk[2]; goto L_180; } } } } intchk[last - 3] = -labs( intchk[last - 3] ); Mact[2] = errbad; } L_180: if (last != kex) intchk[last] = kex; if (Mact[2] > 0) { L_190: if (last != kex) { for (i = last + 1; i <= labs( kex ); i++) { intchk[intchk[i] + 1] = -intchk[intchk[i] + 1]; } if (kex < 0) goto L_210; kex = -kex; } Mact[13] = (last - 4)/3; strcpy(&mtxtaa[1][LTXTEE-1], etext); mess( mact, (char*)mtxtaa,157, &intchk[1] ); /* MTXTAA(2)(LTXTEE:LTXEND)=ETEXT(1:) */ if (Mact[2] > 10) intchk[1] = -last; if (last != kex) goto L_190; } L_210: intchk[2] = intchk[last - 1]; return; } /* end of function */