FLECS VERSION 860214 15-JUN-87 09:33:17 PAGE 00001 CSIVAL.FOR,CSIVAL.FLL/-SP=CSIVAL.FLX/CO:GLBOPT 00001 00000 C;+ 00002 00000 C.ENTRY CSIVAL 00003 00000 C - C S I V A L 00004 00000 C****NAME: SUBROUTINE CSIVAL 00005 00000 C IDENT: /861031/ 00006 00000 C FILE: CSIVAL.FLX 00007 00000 C 00008 00000 C****PURPOSE: Defines the values that may be used with a switch. 00009 00000 C 00010 00000 C****RESTRICTIONS: CSI must be called before this routine. 00011 00000 C This routine must be called immediately after 00012 00000 C the CSISW call that defines the switch. 00013 00000 C Variable BUFFER must be in a COMMON block or be 00014 00000 C declared VOLATILE; see note 7. 00015 00000 C 00016 00000 C SYSTEM: VAX/VMS 1.5 00017 00000 C LANGUAGE: FLECS/F4P 00018 00000 C AUTHOR: M. OOTHOUDT 00019 00000 C DATE: 13-AUG-79 00020 00000 C;- 00021 00000 C REVISIONS: 00022 00000 C 850327mao Document that BUFFER must be in COMMON or VOLATILE. 00023 00000 C 850410mao Rewrite code so that value of optional argument is checked 00024 00000 C after checking if arg exists (FOR V4.x problem). 00025 00000 C 850812mao Use .IMP NONE & .INC. 00026 00000 C 861031mao Allow I*1, I*4, R*4, R*8 switch values. Add HEX argument. 00027 00000 C Document way of overriding integer types. 00028 00000 C;+ 00029 00000 C 00030 00000 C****CALLING SEQUENCE: CALL CSIVAL(NAME,BUFFER,[LENGTH],[OCTAL],[HEX]) 00031 00000 C 00032 00000 C INPUT: 00033 00000 C 00034 00000 C NAME =(2L*1) Byte array containing the first 2 characters of a switch 00035 00000 C name. This must be exactly the same as the NAME in the 00036 00000 C preceeding CSISW call. 00037 00000 C 00038 00000 C BUFFER=(I*1, I*2, I*4, R*4, R*8, or byte array) Array to receive a 00039 00000 C switch value. For an ASCII string the array must be 00040 00000 C at least LENGTH bytes long. For other data types, it 00041 00000 C must be at least as long as the data type--eg. for 00042 00000 C INTEGER*4, it must be at least 4 bytes long. 00043 00000 C Must be in COMMON or declared VOLATILE; see note 7. 00044 00000 C 00045 00000 C LENGTH=(I*2) This argument defines the data type of the switch value: 00046 00000 C >0, the value is an ASCII string with a max size of 00047 00000 C LENGTH bytes 00048 00000 C 0 or argument not given, INTEGER*2 value 00049 00000 C -1, BYTE (INTEGER*1) value 00050 00000 C -2, INTEGER*4 value 00051 00000 C -3, REAL*4 (F Floating) value 00052 00000 C -4, REAL*8 (D Floating) value 00053 00000 C For integer values decimal radix is the default; however 00054 00000 C arguments OCTAL and HEX may change this. See also 00055 00000 C note 4. FLECS VERSION 860214 15-JUN-87 09:33:17 PAGE 00002 CSIVAL.FOR,CSIVAL.FLL/-SP=CSIVAL.FLX/CO:GLBOPT 00056 00000 C 00057 00000 C OCTAL =(I*2) If this argument is present and nonzero, the integer 00058 00000 C switch value is converted as an octal number. See note 4 00059 00000 C 00060 00000 C HEX =(I*2) If the argument is present and nonzero and if OCTAL 00061 00000 C was not given or was zero, the integer switch value is 00062 00000 C converted as a hexadecimal number. See note 4. 00063 00000 C 00064 00000 C OUTPUT: NONE 00065 00000 C 00066 00000 C CMN BLOCK I/O: /CSI_DAT_BASE__/ 00067 00000 C 00068 00000 C RESOURCES: 00069 00000 C LIBRARIES: QLIB:ARGS 00070 00000 C OTHER SUBR: NONE 00071 00000 C DISK FILES: NONE 00072 00000 C DEVICES: NONE 00073 00000 C SGAS: NONE 00074 00000 C EVENT FLAGS: NONE 00075 00000 C SYSTEM DIR: EXIT 00076 00000 C 00077 00000 C****NOTES: 00078 00000 C 1. This subroutine does not return any values. It only sets 00079 00000 C up information for CSIGO. Information will be returned to the caller 00080 00000 C only after CSIGO is called. 00081 00000 C 00082 00000 C 2. This routine need not be called if there are to be no 00083 00000 C switch values in the line to be processed. However, if there are 00084 00000 C values given for a switch in the input line and CSIVAL has not been 00085 00000 C called to define them, CSIGO will give semantic errors. Up to 100. 00086 00000 C switch values may be defined at one time; these switch values may be 00087 00000 C shared in any way between the defined switches. Ie. one switch 00088 00000 C may have 100. values or 10. switches may have 10. values each and 10. 00089 00000 C other switches may have 0. values each, etc. 00090 00000 C 00091 00000 C 3. CSIVAL will put out an error message and force the 00092 00000 C calling image to exit if: 00093 00000 C A. Switch "NAME" is not the "NAME" in the most recent CSISW call; 00094 00000 C B. An attempt is made to define more than 100. switch values. 00095 00000 C 00096 00000 C 4. The default radix for integer switch values is decimal. 00097 00000 C If the OCTAL argument is given, however, the radix is octal for 00098 00000 C the switch. If OCTAL is not given but HEX is given, hexadecimal 00099 00000 C radix is used. The radix specified in the CSIVAL call may be 00100 00000 C overriden, however, by specifying the radix control operators 00101 00000 C %X (hexadecimal), %O (octal), or %D (decimal). Eg. /IN:%XFFD will 00102 00000 C be converted as hexadecimal even if the CSIVAL call specified 00103 00000 C octal as the radix. 00104 00000 C 00105 00000 C 5. If values are defined by a CSIVAL call but are not present 00106 00000 C in the line given to CSIGO, they are returned as zero for numeric 00107 00000 C values or as nulls for an ASCII string. Also for an ASCII string 00108 00000 C if the string in the input LINE is shorter than "LENGTH" the string 00109 00000 C returned is null-extended on the right to make up "LENGTH" bytes; 00110 00000 C if the given string is greater than LENGTH bytes long, only the first FLECS VERSION 860214 15-JUN-87 09:33:17 PAGE 00003 CSIVAL.FOR,CSIVAL.FLL/-SP=CSIVAL.FLX/CO:GLBOPT 00111 00000 C "LENGTH" bytes are returned. 00112 00000 C 00113 00000 C 6. Example: suppose the input LINE may have switches with 00114 00000 C arguments like 00115 00000 C /X:300:500 00116 00000 C /MO:HI:THERE 00117 00000 C /MA:500 OR /MA:CU 00118 00000 C /Z:-300.:1.E7 00119 00000 C 00120 00000 C The proper CSISW and CSIVAL calls to set this up are 00121 00000 C 00122 00000 C LOGICAL*2 XSTATE,MOSTAT,MASTAT,ZSTATE 00123 00000 C INTEGER*2 IX1,IX2 00124 00000 C REAL*4 Z1,Z2 00125 00000 C BYTE MO1(10),MO2(10),MAVAL(10) 00126 00000 C COMMON/CSIVAR/XSTATE,IX1,IX2,MOSTAT,MO1,MO2,MASTAT,MAVAL, 00127 00000 C 1 ZSTATE,Z1,Z2 00128 00000 C CALL CSISW('X',XSTATE,2) 00129 00000 C CALL CSIVAL('X',IX1) !1ST INTEGER VALUE 00130 00000 C CALL CSIVAL('X',IX2) !2ND INTEGER VALUE 00131 00000 C CALL CSISW('MO',MOSTAT,2) 00132 00000 C CALL CSIVAL('MO',MO1(1),10) !1ST ASCII STRING, UP TO 10 LONG 00133 00000 C CALL CSIVAL('MO',MO2(1),10) !2ND ASCII STRING, UP TO 10 LONG 00134 00000 C CALL CSISW('MA',MASTAT,2) 00135 00000 C CALL CSIVAL('MA',MAVAL(1),10) !ASCII STRING, UP TO 10 LONG 00136 00000 C CALL CSISW('Z',ZSTATE,2) 00137 00000 C CALL CSIVAL('Z',Z1,-3) !1ST VALUE 00138 00000 C CALL CSIVAL('Z',Z2,-3) !2ND VALUE 00139 00000 C 00140 00000 C Note for /MA we get an ASCII string. To use it must test the first 2 00141 00000 C characters to see if they are "C" and "U"; if not we must use DECODE 00142 00000 C to get the numeric value. 00143 00000 C 00144 00000 C 7. Under VMS V4.0 and later all arguments whose addresses are 00145 00000 C saved by this subroutine for filling in by CSIGO MUST be made 00146 00000 C VOLATILE or be in a COMMON block in the calling routine. Since the 00147 00000 C VOLATILE statement is incompatible with all other FORTRANs, putting 00148 00000 C the variables in COMMON is best. The variable that must be treated 00149 00000 C this way in the CSIVAL is BUFFER. 00150 00000 C;- FLECS VERSION 860214 15-JUN-87 09:33:17 PAGE 00004 CSIVAL.FOR,CSIVAL.FLL/-SP=CSIVAL.FLX/CO:GLBOPT 00151 00000 .PAGE 00152 00001 SUBROUTINE CSIVAL(NAME,BUFFER,LENGTH,OCTAL,HEX) !861031 00153 00001 C 00154 00001 C GLOBAL CSI DECLARATIONS 00155 00001 C 00156 00003 .IMPLICIT NONE 00157 00003 .INCLUDE CSICOM.INC *00158 00003 C *00159 00003 C CSICOM.INC *00160 00003 C *00161 00003 C THIS FILE IS USED BY CSI ROUTINES VIA AN INCLUDE STATEMENT. *00162 00003 C *00163 00003 C *****NEVER DELETE THIS FILE ******** *00164 00003 C *00165 00003 C REVISIONS: *00166 00003 C 2-FEB-84 (JFA) - INCREASE MAX NO SWITCH VALUES FROM 30 TO 100 *00167 00003 C 850809mao Put file into standard format; convert L*1 variables to I*2. *00168 00003 C 861031mao Add NODIND_ADDR variable. *00169 00003 C *00170 00004 INTEGER*2 MAX_NUM_SW *00171 00005 INTEGER*2 MAX_NUM_VAL *00172 00005 *00173 00006 PARAMETER (MAX_NUM_SW=20) !Max number of switches *00174 00007 PARAMETER (MAX_NUM_VAL=100) !Max number of switch values *00175 00007 C *00176 00008 INTEGER*4 DEVIND_ADDR !Address to return device indicies *00177 00009 INTEGER*4 EQUAL_ADDR !Address to return equal status *00178 00010 INTEGER*4 FILIND_ADDR !Address to return file spec indicies *00179 00011 INTEGER*2 LINE_POINTER(2) !Position in input line after last *00180 00011 C ! CSIGO call; one pointer *00181 00011 C ! for each side of equal sign. *00182 00012 INTEGER*4 MORE_ADDR !Address to return more status *00183 00013 INTEGER*4 NODIND_ADDR !Address to return Node indicies!861031 *00184 00014 INTEGER*2 NUM_SW_DFN !Number of switches defined *00185 00015 INTEGER*2 NUM_SW_VAL_DFN !Number of switch values defined *00186 00016 BYTE SW_NAME(2,MAX_NUM_SW) !ASCII switch names *00187 00017 INTEGER*4 SW_STATE_ADDR(MAX_NUM_SW) !Addr to return sw status *00188 00018 INTEGER*2 SW_STATE_DFLT(MAX_NUM_SW) !Default for sw status *00189 00019 INTEGER*4 SW_VALUE_ADDR(MAX_NUM_VAL) !Addr to return sw value *00190 00020 INTEGER*2 SW_VALUE_CHAIN(2,MAX_NUM_SW) !Pointers to 1st & last sw *00191 00020 C value for a given sw in *00192 00020 C arrays. =(0,0) if no values *00193 00020 C for sw. *00194 00021 INTEGER*2 SW_VALUE_LENGTH(MAX_NUM_VAL) *00195 00021 C >0-->ASCII string, it's max length in bytes *00196 00021 C =0-->Decimal I*2 *00197 00021 C =-1-->Octal I*2 *00198 00021 C =-2-->Hex I*2 *00199 00021 C =-10-->Decimal I*1 *00200 00021 C =-11-->Octal I*1 *00201 00021 C =-12-->Hex I*1 *00202 00021 C =-20-->Decimal I*4 *00203 00021 C =-21-->Octal I*4 *00204 00021 C =-22-->Hex I*4 *00205 00021 C =-30-->Real*4 (F floating) FLECS VERSION 860214 15-JUN-87 09:33:17 PAGE 00005 CSIVAL.FOR,CSIVAL.FLL/-SP=CSIVAL.FLX/CO:GLBOPT *00206 00021 C =-40-->Real*8 (D floating) *00207 00022 INTEGER*4 UICIND_ADDR !Address to return directory indicies *00208 00023 INTEGER*4 WILD_ADDR !Address to return WILD status *00209 00023 C *00210 00024 COMMON/CSI_DATA_BASE__/LINE_POINTER, *00211 00025 1 NUM_SW_DFN,NUM_SW_VAL_DFN,NODIND_ADDR,DEVIND_ADDR,UICIND_ADDR, *00212 00026 2 FILIND_ADDR,MORE_ADDR,WILD_ADDR,EQUAL_ADDR,SW_NAME, *00213 00027 3 SW_STATE_ADDR,SW_STATE_DFLT,SW_VALUE_ADDR,SW_VALUE_LENGTH, *00214 00028 4 SW_VALUE_CHAIN *00215 00028 C *00216 00028 C END OF FILE 00217 00028 C 00218 00028 C LOCAL DECLARATIONS 00219 00028 C 00220 00029 BYTE NAME(2),TST 00221 00030 INTEGER*2 BUFFER,LENGTH,OCTAL,NARGS,MAP 00222 00031 INTEGER*2 HEX,RADIX !861031 00223 00032 LOGICAL*2 LENP,OCTP,HEXP !861031 FLECS VERSION 860214 15-JUN-87 09:33:17 PAGE 00006 CSIVAL.FOR,CSIVAL.FLL/-SP=CSIVAL.FLX/CO:GLBOPT 00224 00032 .PAGE 00225 00032 C 00226 00032 C SW 'NAME' MUST BE LAST ENTRY IN SW TABLE, IE. MUST 00227 00032 C CALL CSISW('SA',...) 00228 00032 C CALL CSIVAL('SA',...) 00229 00032 C IF CSISW CALL FOR ANOTHER SW WERE TO INTERVENE BETWEEN CSISW AND 00230 00032 C CSIVAL CALLS FOR SAME SW, SW TABLE WOULD BE BOTCHED UP. 00231 00032 C 00232 00033 TST=NAME(1).NE.SW_NAME(1,NUM_SW_DFN).OR.NAME(2).NE.SW_NAME(2, 00233 00034 1 NUM_SW_DFN) 00234 00035 WHEN(TST) 00235 00036 . TYPE 1,NAME 00236 00037 1 . FORMAT(' CSIVAL--SWITCH "',2A1,'" NOT YET DEFINED OR',/, 00237 00038 1. ' CSIVAL CALL NOT IMMEDIATELY AFTER CORRESPONDING', 00238 00039 2. ' CSISW CALL') 00239 00040 . CALL EXIT !PDP11 CSIVAL FORCES EXIT! 00240 00040 ...FIN 00241 00041 ELSE 00242 00041 C . 00243 00041 C . IS THERE ROOM FOR MORE SW VALUES? 00244 00041 C . 00245 00042 . WHEN(NUM_SW_VAL_DFN.EQ.MAX_NUM_VAL) 00246 00043 . . TYPE 2,NAME 00247 00044 2 . . FORMAT(' CSIVAL--OUT OF ROOM FOR VALUE FOR SWITCH "',2A1,'"') 00248 00045 . . CALL EXIT !PDP11 CSIVAL FORCES EXIT! 00249 00045 . ...FIN 00250 00046 . ELSE 00251 00046 C . . 00252 00046 C . . ALL OK--STORE SWITCH DESCRIPTOR PARAMETERS 00253 00046 C . . 00254 00047 . . NUM_SW_VAL_DFN=NUM_SW_VAL_DFN+1 00255 00048 . . SW_VALUE_ADDR(NUM_SW_VAL_DFN)=%LOC(BUFFER) 00256 00049 . . IF (SW_VALUE_CHAIN(1,NUM_SW_DFN) .EQ. 0) 00257 00050 . . . SW_VALUE_CHAIN(1,NUM_SW_DFN) = NUM_SW_VAL_DFN 00258 00050 . . ...FIN !IF 00259 00052 . . SW_VALUE_CHAIN(2,NUM_SW_DFN)=NUM_SW_VAL_DFN 00260 00052 C . . 00261 00052 C . . NOW PROCESS OPTIONAL ARGUMENTS 00262 00052 C . . 00263 00053 . . CALL ARGS(NARGS,MAP) 00264 00054 . . LENP = (NARGS.GE.3) .AND. ((MAP.AND."4).NE.0) !861031 00265 00055 . . OCTP = (NARGS.GE.4) .AND. ((MAP.AND."10).NE.0) !861031 00266 00056 . . HEXP = (NARGS.GE.5) .AND. ((MAP.AND."20).NE.0) !861031 00267 00056 . . 00268 00057 . . IF ((OCTP) .AND. OCTAL.NE.0) THEN !861031 00269 00058 . . . RADIX = -1 !octal radix !861031 00270 00059 . . ELSEIF ((HEXP) .AND. HEX.NE.0) THEN !861031 00271 00060 . . . RADIX = -2 !hexidecimal !861031 00272 00061 . . ELSE !861031 00273 00062 . . . RADIX = 0 !decimal !861031 00274 00063 . . ENDIF 00275 00063 . . 00276 00064 . . IF (.NOT.LENP) THEN !861031 00277 00065 . . . SW_VALUE_LENGTH(NUM_SW_VAL_DFN) = RADIX !INTEGER*2 !861031 00278 00065 . . . FLECS VERSION 860214 15-JUN-87 09:33:17 PAGE 00007 CSIVAL.FOR,CSIVAL.FLL/-SP=CSIVAL.FLX/CO:GLBOPT 00279 00066 . . ELSEIF (LENGTH.GT.0) THEN !861031 00280 00067 . . . SW_VALUE_LENGTH(NUM_SW_VAL_DFN)=LENGTH !ASCII string !861031 00281 00067 . . . 00282 00068 . . ELSEIF (LENGTH.EQ.0) THEN !861031 00283 00069 . . . SW_VALUE_LENGTH(NUM_SW_VAL_DFN) = RADIX !INTEGER*2 !861031 00284 00069 . . . 00285 00070 . . ELSEIF (LENGTH.EQ.-1) THEN !861031 00286 00071 . . . SW_VALUE_LENGTH(NUM_SW_VAL_DFN) = RADIX-10 !INTEGER*1!86103 00287 00071 . . . 00288 00072 . . ELSEIF (LENGTH.EQ.-2) THEN !861031 00289 00073 . . . SW_VALUE_LENGTH(NUM_SW_VAL_DFN) = RADIX-20 !INTEGER*4!86103 00290 00073 . . . 00291 00074 . . ELSEIF (LENGTH.EQ.-3) THEN !861031 00292 00075 . . . SW_VALUE_LENGTH(NUM_SW_VAL_DFN) = RADIX-30 !REAL*4 !861031 00293 00075 . . . 00294 00076 . . ELSEIF (LENGTH.EQ.-4) THEN !861031 00295 00077 . . . SW_VALUE_LENGTH(NUM_SW_VAL_DFN) = RADIX-40 !REAL*8 !861031 00296 00077 . . . 00297 00078 . . ELSE !861031 00298 00078 . . . 00299 00079 . . . TYPE 3,NAME !861031 00300 00080 3 . . . FORMAT(' CSIVAL--Switch"',2A1,'" LENGTH has illegal value')!861031 00301 00081 . . . CALL EXIT !861031 00302 00082 . . ENDIF !861031 00303 00082 . . 00304 00082 . ...FIN!else 00305 00083 ...FIN!else 00306 00085 RETURN 00307 00086 END (FLECS VERSION 22.38) CSIVAL 15-Jun-1987 09:33:19 VAX FORTRAN V4.5-219 Page 3 15-Jun-1987 09:33:17 $1$DUA11:[MP1Q.FLEALECOM.QLIB]CSIVAL.FOR;1 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 527 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 221 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 36 PIC CON REL LCL NOSHR NOEXE RD WRT LONG 3 CSI_DATA_BASE__ 876 PIC OVR REL GBL SHR NOEXE RD WRT LONG Total Space Allocated 1660 ENTRY POINTS Address Type Name 0-00000000 CSIVAL VARIABLES Address Type Name Address Type Name AP-00000008@ I*2 BUFFER 3-0000000C I*4 DEVIND_ADDR 3-00000020 I*4 EQUAL_ADDR 3-00000014 I*4 FILIND_ADDR AP-00000014@ I*2 HEX ** L*2 HEXP AP-0000000C@ I*2 LENGTH ** L*2 LENP 2-00000002 I*2 MAP 3-00000018 I*4 MORE_ADDR 2-00000000 I*2 NARGS 3-00000008 I*4 NODIND_ADDR 3-00000004 I*2 NUM_SW_DFN 3-00000006 I*2 NUM_SW_VAL_DFN AP-00000010@ I*2 OCTAL ** L*2 OCTP ** I*2 RADIX ** L*1 TST 3-00000010 I*4 UICIND_ADDR 3-0000001C I*4 WILD_ADDR ARRAYS Address Type Name Bytes Dimensions 3-00000000 I*2 LINE_POINTER 4 (2) AP-00000004@ L*1 NAME 2 (2) 3-00000024 L*1 SW_NAME 40 (2, 20) 3-0000004C I*4 SW_STATE_ADDR 80 (20) 3-0000009C I*2 SW_STATE_DFLT 40 (20) 3-000000C4 I*4 SW_VALUE_ADDR 400 (100) 3-0000031C I*2 SW_VALUE_CHAIN 80 (2, 20) 3-00000254 I*2 SW_VALUE_LENGTH 200 (100) LABELS Address Label Address Label Address Label 1-00000000 1' 1-00000075 2' 1-000000AA 3' CSIVAL 15-Jun-1987 09:33:19 VAX FORTRAN V4.5-219 Page 4 15-Jun-1987 09:33:17 $1$DUA11:[MP1Q.FLEALECOM.QLIB]CSIVAL.FOR;1 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name ARGS FOR$EXIT COMMAND QUALIFIERS FORTRAN/F77/LIST=CSIVAL.LST/NOI4/F77 CSIVAL /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /STANDARD=(NOSYNTAX,NOSOURCE_FORM) /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP,NODICTIONARY,SINGLE) /WARNINGS=(GENERAL,NODECLARATIONS,NOULTRIX) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /NOI4 /NOMACHINE_CODE /OPTIMIZE COMPILATION STATISTICS Run Time: 0.51 seconds Elapsed Time: 1.22 seconds Page Faults: 607 Dynamic Memory: 372 pages