SUBROUTINE CSIGO (LINE,LENGTH,TYPE,ERROR) 00121 IMPLICIT NONE 00125 INCLUDE ' 32766 .FID/NOLIST' 00125 INTEGER*2 MAX_NUM_SW 00139 INTEGER*2 MAX_NUM_VAL 00140 PARAMETER (MAX_NUM_SW=20) !Max number of switches 00142 PARAMETER (MAX_NUM_VAL=100) !Max number of switch values 00143 INTEGER*4 DEVIND_ADDR !Address to return device indicies 00145 INTEGER*4 EQUAL_ADDR !Address to return equal status 00146 INTEGER*4 FILIND_ADDR !Address to return file spec indicies 00147 INTEGER*2 LINE_POINTER(2) !Position in input line after last 00148 INTEGER*4 MORE_ADDR !Address to return more status 00151 INTEGER*4 NODIND_ADDR !Address to return Node indicies!861031 00152 INTEGER*2 NUM_SW_DFN !Number of switches defined 00153 INTEGER*2 NUM_SW_VAL_DFN !Number of switch values defined 00154 BYTE SW_NAME(2,MAX_NUM_SW) !ASCII switch names 00155 INTEGER*4 SW_STATE_ADDR(MAX_NUM_SW) !Addr to return sw status 00156 INTEGER*2 SW_STATE_DFLT(MAX_NUM_SW) !Default for sw status 00157 INTEGER*4 SW_VALUE_ADDR(MAX_NUM_VAL) !Addr to return sw value 00158 INTEGER*2 SW_VALUE_CHAIN(2,MAX_NUM_SW) !Pointers to 1st & last sw 00159 INTEGER*2 SW_VALUE_LENGTH(MAX_NUM_VAL) 00163 INTEGER*4 UICIND_ADDR !Address to return directory indicies 00176 INTEGER*4 WILD_ADDR !Address to return WILD status 00177 COMMON/CSI_DATA_BASE__/LINE_POINTER, 00179 1 NUM_SW_DFN,NUM_SW_VAL_DFN,NODIND_ADDR,DEVIND_ADDR,UICIND_ADDR, 00180 2 FILIND_ADDR,MORE_ADDR,WILD_ADDR,EQUAL_ADDR,SW_NAME, 00181 3 SW_STATE_ADDR,SW_STATE_DFLT,SW_VALUE_ADDR,SW_VALUE_LENGTH, 00182 4 SW_VALUE_CHAIN 00183 BYTE LINE(80),TYPE,SEARCH_CHAR,BLANK,TAB,EQUAL,COMMA, 00189 1 RIGHT_BRACKET,SLASH,COLON,MINUS,ASTERIC,NAM(2),PERIOD, 00190 2 LEFT_BRACKET,SEMICOLON 00191 LOGICAL*1 CONT,SW_NEG,TST 00192 LOGICAL*2 ERROR 00193 LOGICAL*2 ITYP !Added only to make a FLECS line short enough 00194 LOGICAL*2 OCTAL !Added only to make a FLECS line short enough 00195 LOGICAL*2 STAR !Added only to make a FLECS line short enough 00196 INTEGER*2 LENGTH,I,IDX,NARGS,MAP,LOC_ERROR,ICHAR,LEND,IEQUAL, 00197 1 INAM,INAME(MAX_NUM_SW) 00198 INTEGER*4 J !scratch !861031 00199 REAL*8 RR !scratch !861031 00200 EQUIVALENCE(NAM(1),INAM),(SW_NAME(1,1),INAME(1)) 00201 INTEGER*2 TMP_SW_STATE(MAX_NUM_SW) !Internal storage for sw status00206 INTEGER*4 TMP_SW_VALUE(2,MAX_NUM_VAL) !Internal storage for sw 00207 REAL*8 TMP_SW_VALUE_RR(MAX_NUM_VAL) !EQUIV to TMP_SW_VALUE 00212 INTEGER*2 TMP_NODIND(2) !Internal storage for pntrs to node string00213 INTEGER*2 TMP_DEVIND(2) !INTERNAL STORAGE FOR PNTRS TO DEVICE STRI00214 INTEGER*2 TMP_UICIND(2) !INTERNAL STORAGE FOR PNTRS TO DIR STRING 00215 INTEGER*2 TMP_FILIND(2) !INTERNAL STORAGE FOR PNTRS TO FILENAME ST00216 LOGICAL*2 TMP_MORE !INTERNAL STORAGE FOR MORE FLAG 00217 LOGICAL*2 TMP_WILD !INTERNAL STORAGE FOR WILD CARD FLAG 00218 LOGICAL*2 TMP_EQUAL !INTERNAL STORAGE FOR EQUAL FLAG 00219 INTEGER*2 LEN_CMPRS !LENGTH OF LINE AFTER SQUEEZING OUT 00220 !BLANKS AND TABS 00221 INTEGER*2 LEN_SUBSTRING !LENGTH OF SUBSTRING BEING PROCESSED 00222 INTEGER*2 ISTRNG_STRT !1ST CHAR IN CURRENT SUBSTRING 00223 INTEGER*2 ISTRNG_END !LAST CHAR IN CURRENT SUBSTRING 00224 INTEGER*2 LOCATION !CURRENT LOCATION IN LINE FOR PARSING 00225 INTEGER*2 LOC_SLASH !LOCATION OF NEXT (OR 1ST) SLASH (SWITCH) 00226 INTEGER*2 LOC_COLON !LOC OF NEXT (OR 1ST) COLON FOR SW VALUE 00227 INTEGER*2 I_STRT_SW !1ST CHARACTER IN SW STRING 00228 INTEGER*2 I_END_SW !LAST CHARACTER IN SW STRING 00229 INTEGER*2 NSW !LOCATION OF SW IN SW_NAME ARRAY 00230 INTEGER*2 I_STRT_VAL !1ST CHARACTER IN A SW VALUE 00231 INTEGER*2 I_END_VAL !LAST CHARACTER IN A SW VALUE 00232 INTEGER*2 NVAL !NUMBER OF VALUES FOUND FOR A SW 00233 LOGICAL*2 QUOTE !.T.==>we are between "s 00234 EQUIVALENCE (TMP_SW_VALUE(1,1),TMP_SW_VALUE_RR(1)) 00236 DATA BLANK/"40/,TAB/"11/,EQUAL/1H=/,COMMA/1H,/,LEFT_BRACKET/1H[/, 00238 1 RIGHT_BRACKET/1H]/,SLASH/1H//,COLON/1H:/,ASTERIC/1H*/, 00239 2 MINUS/1H-/,PERIOD/1H./,SEMICOLON/1H;/ 00240 CONT=.TRUE. 00242 CALL ARGS(NARGS,MAP) 00243 ASSIGN 32757 TO I32758 00245 GO TO 32758 00245 32757 IF(LENGTH.GT.0)THEN 00247 ASSIGN 32755 TO I32756 00249 GO TO 32756 00249 32755 IF(I.EQ.0)THEN 00250 ASSIGN 32753 TO I32754 00251 GO TO 32754 00251 32753 ASSIGN 32751 TO I32752 00252 GO TO 32752 00252 32751 LINE_POINTER(1)=0 !START OF OUTPUT SPECS-1 00253 LINE_POINTER(2)=IEQUAL !START OF INPUT SPECS-1 00254 ENDIF 00255 IF(CONT.AND.LEN_CMPRS.GT.0)THEN 00257 ASSIGN 32749 TO I32750 00258 GO TO 32750 00258 32749 IF(LEN_SUBSTRING.GT.0)THEN 00260 LOCATION=ISTRNG_STRT 00261 ASSIGN 32747 TO I32748 00262 GO TO 32748 00262 32747 IF(LOC_SLASH.NE.ISTRNG_STRT)THEN 00263 ASSIGN 32745 TO I32746 00263 GO TO 32746 00263 32745 CONTINUE 00263 ENDIF 00263 IF(CONT)THEN 00264 ASSIGN 32743 TO I32744 00264 GO TO 32744 00264 32743 CONTINUE 00264 ENDIF 00264 IF(LOC_SLASH.NE.0.AND.CONT)THEN 00265 ASSIGN 32741 TO I32742 00265 GO TO 32742 00265 32741 CONTINUE 00265 ENDIF 00265 ENDIF 00266 ENDIF 00267 ENDIF 00268 IF(CONT)THEN 00270 ASSIGN 32739 TO I32740 00271 GO TO 32740 00271 32739 IF(NUM_SW_DFN.GT.0)THEN 00272 ASSIGN 32737 TO I32738 00272 GO TO 32738 00272 32737 CONTINUE 00272 ENDIF 00272 ASSIGN 32735 TO I32736 00273 GO TO 32736 00273 32735 CONTINUE 00274 ENDIF 00274 IF(NARGS.GE.4.AND.((MAP.AND."10).NE.0))ERROR=.NOT.CONT 00276 RETURN 00277 32758 CONTINUE 00279 DO I=1,2 00283 TMP_NODIND(I)=0 !861031 00284 TMP_DEVIND(I)=0 00285 TMP_UICIND(I)=0 00286 TMP_FILIND(I)=0 00287 ENDDO 00288 DO I=1,NUM_SW_DFN 00292 TMP_SW_STATE(I)=SW_STATE_DFLT(I) 00292 ENDDO 00292 DO I=1,NUM_SW_VAL_DFN 00293 TMP_SW_VALUE(1,I)=0 00294 TMP_SW_VALUE(2,I)=0 00295 ENDDO 00296 TMP_MORE=.FALSE. 00300 TMP_WILD=.FALSE. 00301 IF (NARGS.LT.3 .OR. ((MAP.AND.'7'O).EQ.0)) TYPE = 'O' 00305 GO TO I32758 00306 32756 CONTINUE 00308 I=0 !assume MORE_ADDR=0 or MORE=.F. 00313 IF(MORE_ADDR.NE.0)THEN 00315 CALL LIB$MOVC3(1,%VAL(MORE_ADDR),TST) !get value of user's MOR00316 IF (TST) I=1 00317 ENDIF 00318 GO TO I32756 00319 32754 CONTINUE 00321 LEN_CMPRS=0 00326 QUOTE = .FALSE. !NO " yet !861031 00327 DO I=1,LENGTH 00328 IF(QUOTE .OR. (LINE(I).NE.BLANK.AND.LINE(I).NE.TAB))THEN 00329 LEN_CMPRS=LEN_CMPRS+1 00330 LINE(LEN_CMPRS)=LINE(I) 00331 ENDIF 00332 IF (LINE(I).EQ.1H") QUOTE=.NOT.QUOTE !861031 00333 ENDDO 00334 IF(LEN_CMPRS.LT.LENGTH)THEN 00335 DO I=LEN_CMPRS+1,LENGTH 00336 LINE(I)=BLANK 00336 ENDDO 00336 ENDIF 00337 GO TO I32754 00338 32752 CONTINUE 00339 SEARCH_CHAR=EQUAL 00343 ICHAR=1 00344 LEND=LEN_CMPRS 00345 ASSIGN 32733 TO I32734 00346 GO TO 32734 00346 32733 IEQUAL=ICHAR 00347 IF(ICHAR.EQ.0)THEN 00348 TMP_EQUAL=.FALSE. 00348 ELSE 00349 TMP_EQUAL=.TRUE. 00350 ICHAR=ICHAR+1 00354 ASSIGN 32732 TO I32734 00355 GO TO 32734 00355 32732 IF(ICHAR.NE.0)THEN 00356 LOC_ERROR=ICHAR 00357 ASSIGN 32730 TO I32731 00358 GO TO 32731 00358 32730 CONTINUE 00359 ENDIF 00359 ENDIF 00360 GO TO I32752 00361 32734 CONTINUE 00362 DOWHILE(.NOT.(ICHAR.GT.LEND.OR.LINE(ICHAR).EQ.SEARCH_CHAR)) 00369 ICHAR=ICHAR+1 00369 ENDDO 00369 IF(ICHAR.GT.LEND)ICHAR=0 00370 GO TO I32734 00371 32731 CONTINUE 00372 TYPE 1,(LINE(I),I=1,LOC_ERROR) 00376 1 FORMAT(' CSIGO--SYNTAX ERROR:',/,(1X,70A1)) 00377 CONT=.FALSE. 00378 GO TO I32731 00379 32750 CONTINUE 00380 IF(TYPE.EQ.'I')THEN 00384 ITYP = .TRUE. 00384 ELSE 00385 ITYP = .FALSE. 00385 ENDIF 00385 IF(NARGS.GE.3.AND.((MAP.AND."4).NE.0).AND.ITYP)THEN 00386 J=2 00387 ELSE 00389 J=1 00389 ENDIF 00389 IF(J.EQ.2.AND..NOT.TMP_EQUAL)THEN 00393 LEN_SUBSTRING=0 00394 ELSE 00396 ISTRNG_STRT=LINE_POINTER(J)+1 !START IS EASY 00397 SEARCH_CHAR=COMMA !END IS AT COMMA OR END OF SCAN 00398 ICHAR=ISTRNG_STRT 00399 IF(J.EQ.2.OR.IEQUAL.EQ.0)THEN 00400 LEND=LEN_CMPRS 00400 ELSE 00401 LEND=IEQUAL-1 00401 ENDIF 00401 ASSIGN 32729 TO I32734 00402 GO TO 32734 00402 32729 IF(ICHAR.EQ.0)THEN 00403 ISTRNG_END=LEND 00407 TMP_MORE=.FALSE. 00408 ELSE 00410 LOCATION=ICHAR 00414 ICHAR=ISTRNG_STRT 00415 SEARCH_CHAR=LEFT_BRACKET 00416 ASSIGN 32728 TO I32734 00417 GO TO 32734 00417 32728 IF(ICHAR.EQ.0.OR.ICHAR.GT.LOCATION)THEN 00418 ISTRNG_END=LOCATION-1 00422 TMP_MORE=.TRUE. 00423 ELSE 00425 SEARCH_CHAR = RIGHT_BRACKET 00429 ICHAR = ICHAR + 1 00430 ASSIGN 32727 TO I32734 00431 GO TO 32734 00431 32727 IF(ICHAR.NE.0 .AND. ICHAR.LT.LOCATION)THEN 00432 ISTRNG_END = LOCATION -1 00436 TMP_MORE = .TRUE. 00437 ELSE 00439 ICHAR=LOCATION+1 00443 SEARCH_CHAR=COMMA 00444 ASSIGN 32726 TO I32734 00445 GO TO 32734 00445 32726 IF(ICHAR.EQ.0)THEN 00446 ISTRNG_END=LEND 00450 TMP_MORE=.FALSE. 00451 ELSE 00453 ISTRNG_END=ICHAR-1 00457 TMP_MORE=.TRUE. 00458 ENDIF 00459 ENDIF 00460 ENDIF 00461 ENDIF 00462 LEN_SUBSTRING=ISTRNG_END-ISTRNG_STRT+1 00463 LINE_POINTER(J)=ISTRNG_END+1 00464 ENDIF 00465 GO TO I32750 00466 32748 CONTINUE 00467 SEARCH_CHAR=SLASH 00472 ICHAR=LOCATION 00473 LEND=ISTRNG_END 00474 ASSIGN 32725 TO I32734 00475 GO TO 32734 00475 32725 LOC_SLASH=ICHAR 00476 GO TO I32748 00477 32746 CONTINUE 00478 SEARCH_CHAR=COLON !861031 00482 ICHAR=LOCATION !861031 00483 IF(LOC_SLASH.EQ.0)THEN 00484 LEND=ISTRNG_END !861031 00484 ELSE 00485 LEND=LOC_SLASH-1 !861031 00485 ENDIF 00485 ASSIGN 32724 TO I32734 00486 GO TO 32734 00486 32724 IF(ICHAR.NE.0)THEN 00487 IF((ICHAR+1).LE.LEND .AND. LINE(ICHAR+1).EQ.COLON)THEN 00488 TMP_NODIND(1)=ISTRNG_STRT !861031 00489 TMP_NODIND(2)=ICHAR-1 !exclude :: !861031 00490 LOCATION=ICHAR+2 !skip over :: !861031 00491 ENDIF 00492 ENDIF 00493 SEARCH_CHAR=COLON 00497 ICHAR=LOCATION 00498 ASSIGN 32723 TO I32734 00499 GO TO 32734 00499 32723 IF(ICHAR.NE.0)THEN 00500 TMP_DEVIND(1)=LOCATION !861031 00501 TMP_DEVIND(2)=ICHAR-1 !PDP11 CSIGO EXCLUDES COLON TOO 00502 LOCATION=ICHAR+1 00503 ENDIF 00504 SEARCH_CHAR=LEFT_BRACKET 00508 ICHAR=LOCATION 00509 ASSIGN 32722 TO I32734 00510 GO TO 32734 00510 32722 IF(ICHAR.NE.0)THEN 00511 TMP_UICIND(1)=ICHAR 00512 SEARCH_CHAR=RIGHT_BRACKET 00513 ICHAR=TMP_UICIND(1)+1 00514 ASSIGN 32721 TO I32734 00515 GO TO 32734 00515 32721 IF(ICHAR.EQ.0)THEN 00516 IF(LOC_SLASH.EQ.0)THEN 00517 LOC_ERROR=ISTRNG_END 00517 ELSE 00518 LOC_ERROR=LOC_SLASH 00518 ENDIF 00518 ASSIGN 32720 TO I32731 00519 GO TO 32731 00519 32720 CONTINUE 00521 ELSE 00521 TMP_UICIND(2)=ICHAR 00522 LOCATION=ICHAR+1 00523 ENDIF 00524 ENDIF 00525 IF(CONT)THEN 00526 IF(LOC_SLASH.EQ.0)THEN 00530 I=ISTRNG_END 00530 ELSE 00531 I=LOC_SLASH-1 00531 ENDIF 00531 IF(I-LOCATION.GE.0)THEN 00532 TMP_FILIND(1)=LOCATION 00533 TMP_FILIND(2)=I 00534 ENDIF 00535 ENDIF 00536 GO TO I32746 00537 32744 CONTINUE 00538 IF(TMP_NODIND(1).NE.0)THEN 00546 ASSIGN 32718 TO I32719 00546 GO TO 32719 00546 32718 CONTINUE 00546 ENDIF 00546 IF(CONT.AND.TMP_DEVIND(1).NE.0)THEN 00547 ASSIGN 32716 TO I32717 00547 GO TO 32717 00547 32716 CONTINUE 00547 ENDIF 00547 IF(CONT.AND.TMP_UICIND(1).NE.0)THEN 00548 ASSIGN 32714 TO I32715 00548 GO TO 32715 00548 32714 CONTINUE 00548 ENDIF 00548 IF(CONT.AND.TMP_FILIND(1).NE.0)THEN 00549 ASSIGN 32712 TO I32713 00549 GO TO 32713 00549 32712 CONTINUE 00549 ENDIF 00549 IF(CONT.AND.LOC_SLASH.NE.0)THEN 00550 ASSIGN 32710 TO I32711 00550 GO TO 32711 00550 32710 CONTINUE 00550 ENDIF 00550 GO TO I32744 00551 32719 CONTINUE 00552 I=TMP_NODIND(2)+3 !861031 00562 IF(NODIND_ADDR.EQ.0)THEN 00564 LOC_ERROR = I-1 ! (for compat with old CSI) !861031 00565 ASSIGN 32709 TO I32731 00566 GO TO 32731 00566 32709 CONTINUE 00568 ELSEIF(TMP_DEVIND(1).NE.0.AND.TMP_DEVIND(1).EQ.I)THEN 00568 CONTINUE !OK !861031 00569 ELSEIF(TMP_UICIND(1).NE.0.AND.TMP_UICIND(1).EQ.I)THEN 00571 CONTINUE !OK !861031 00572 ELSEIF(TMP_FILIND(1).NE.0.AND.TMP_FILIND(1).EQ.I)THEN 00574 CONTINUE !OK !861031 00575 ELSEIF(LOC_SLASH.NE.0.AND.LOC_SLASH.EQ.I)THEN 00577 CONTINUE !OK !861031 00578 ELSEIF(LOC_SLASH.EQ.0.AND.ISTRNG_END.EQ.I-1)THEN 00580 CONTINUE !OK !861031 00581 ELSE 00583 LOC_ERROR=I !861031 00584 ASSIGN 32708 TO I32731 00585 GO TO 32731 00585 32708 CONTINUE 00587 ENDIF 00587 GO TO I32719 00588 32717 CONTINUE 00589 I=TMP_DEVIND(2)+2 00597 IF(TMP_UICIND(1).NE.0.AND.TMP_UICIND(1).EQ.I)THEN 00599 CONTINUE !OK 00600 ELSEIF(TMP_FILIND(1).NE.0.AND.TMP_FILIND(1).EQ.I)THEN 00602 CONTINUE !OK 00603 ELSEIF(LOC_SLASH.NE.0.AND.LOC_SLASH.EQ.I)THEN 00605 CONTINUE !OK 00606 ELSEIF(LOC_SLASH.EQ.0.AND.ISTRNG_END.EQ.I-1)THEN 00608 CONTINUE !OK 00609 ELSE 00611 LOC_ERROR=I 00612 ASSIGN 32707 TO I32731 00613 GO TO 32731 00613 32707 CONTINUE 00615 ENDIF 00615 GO TO I32717 00616 32715 CONTINUE 00617 SEARCH_CHAR=COMMA 00621 ICHAR=TMP_UICIND(1)+1 00622 LEND=TMP_UICIND(2)-1 00623 ASSIGN 32706 TO I32734 00624 GO TO 32734 00624 32706 IF(ICHAR.NE.0)THEN 00625 I=ICHAR-TMP_UICIND(1)-1 00629 IF(I.EQ.1.AND.LINE(TMP_UICIND(1)+1).EQ.ASTERIC)THEN 00631 TMP_WILD=.TRUE. 00632 ELSEIF(I.GT.0.AND.I.LT.4)THEN 00634 DECODE(I,5,LINE(TMP_UICIND(1)+1),ERR=1500)J 00635 5 FORMAT(O3) 00636 IF(J.LT.0.OR.J.GT."377)GO TO 1500 00637 ELSE 00639 1500 LOC_ERROR=ICHAR 00640 ASSIGN 32705 TO I32731 00641 GO TO 32731 00641 32705 CONTINUE 00643 ENDIF 00643 IF(CONT)THEN 00644 I=TMP_UICIND(2)-ICHAR-1 00648 IF(I.EQ.1.AND.LINE(ICHAR+1).EQ.ASTERIC)THEN 00650 TMP_WILD=.TRUE. 00651 ELSEIF(I.GT.0.AND.I.LT.4)THEN 00653 DECODE(I,5,LINE(ICHAR+1),ERR=1600)J 00654 IF(J.LT.0.OR.J.GT."377)GO TO 1600 00655 ELSE 00657 1600 LOC_ERROR=TMP_UICIND(2) 00658 ASSIGN 32704 TO I32731 00659 GO TO 32731 00659 32704 CONTINUE 00661 ENDIF 00661 ENDIF 00662 ELSE 00664 IDX = TMP_UICIND(1) + 1 00668 DOWHILE(IDX.LE.TMP_UICIND(2)-1 .AND. CONT) 00669 IF(LINE(IDX).EQ.'_')THEN 00671 CONTINUE !870714 00671 ELSEIF(LINE(IDX).EQ.'.')THEN 00672 ELSEIF(LINE(IDX).GE.'0' .AND. LINE(IDX).LE.'9')THEN 00673 ELSEIF(LINE(IDX).GE.'A' .AND. LINE(IDX).LE.'Z')THEN 00674 ELSE 00675 LOC_ERROR = TMP_UICIND(1) + IDX 00676 ASSIGN 32703 TO I32731 00677 GO TO 32731 00677 32703 CONTINUE 00679 ENDIF 00679 IDX = IDX + 1 00680 ENDDO 00681 ENDIF 00682 IF(CONT)THEN 00683 I=TMP_UICIND(2)+1 00688 IF(TMP_FILIND(1).NE.0.AND.TMP_FILIND(1).EQ.I)THEN 00690 CONTINUE !OK 00691 ELSEIF(LOC_SLASH.NE.0.AND.LOC_SLASH.EQ.I)THEN 00693 CONTINUE !OK 00694 ELSEIF(LOC_SLASH.EQ.0.AND.ISTRNG_END.EQ.I-1)THEN 00696 CONTINUE !OK 00697 ELSE 00699 LOC_ERROR=I 00700 ASSIGN 32702 TO I32731 00701 GO TO 32731 00701 32702 CONTINUE 00703 ENDIF 00703 ENDIF 00704 GO TO I32715 00705 32713 CONTINUE 00706 SEARCH_CHAR=PERIOD 00710 ICHAR=TMP_FILIND(1) 00711 LEND=TMP_FILIND(2) 00712 ASSIGN 32701 TO I32734 00713 GO TO 32734 00713 32701 I=ICHAR 00714 SEARCH_CHAR=SEMICOLON 00715 ICHAR=TMP_FILIND(1) 00716 ASSIGN 32700 TO I32734 00717 GO TO 32734 00717 32700 J=ICHAR 00718 IF(J.NE.0.AND.J.LT.I)THEN 00719 LOC_ERROR=I 00720 ASSIGN 32699 TO I32731 00721 GO TO 32731 00721 32699 CONTINUE 00722 ENDIF 00722 IF(CONT)THEN 00723 IF(I.NE.0)THEN 00729 ICHAR=I-1 00729 ELSEIF(J.NE.0)THEN 00730 ICHAR=J-1 00730 ELSE 00731 ICHAR=TMP_FILIND(2) 00731 ENDIF 00732 IF(ICHAR-TMP_FILIND(1).GT.38)THEN 00733 LOC_ERROR=ICHAR 00734 ASSIGN 32698 TO I32731 00735 GO TO 32731 00735 32698 CONTINUE 00736 ENDIF 00736 ENDIF 00737 IF(CONT)THEN 00738 IF(LINE(ICHAR).EQ.ASTERIC)THEN 00742 STAR = .TRUE. 00742 ELSE 00743 STAR = .FALSE. 00743 ENDIF 00743 IF(ICHAR.EQ.TMP_FILIND(1) .AND. STAR)THEN 00744 TMP_WILD=.TRUE. 00745 ELSE 00747 LEND=TMP_FILIND(1) 00748 DOWHILE(LEND.LE.ICHAR.AND.CONT) 00749 IF(LINE(LEND).GE.1HA.AND.LINE(LEND).LE.1HZ)THEN 00751 CONTINUE !OK, A-Z 00752 ELSEIF(LINE(LEND).GE.1Ha.AND.LINE(LEND).LE.1Hz)THEN 00754 CONTINUE !OK, a-z 00755 ELSEIF(LINE(LEND).GE.1H0.AND.LINE(LEND).LE.1H9)THEN 00757 CONTINUE !OK, 1-9 00758 ELSEIF(LINE(LEND).EQ.1H_)THEN 00760 CONTINUE !OK, _ 00761 ELSEIF(LINE(LEND).EQ.1H$)THEN 00763 CONTINUE !OK, $ 00764 ELSE 00766 LOC_ERROR=LEND 00767 ASSIGN 32697 TO I32731 00768 GO TO 32731 00768 32697 CONTINUE 00770 ENDIF 00770 LEND=LEND+1 00771 ENDDO 00772 ENDIF 00773 ENDIF 00774 IF(CONT.AND.I.NE.0)THEN 00775 IF(J.NE.0)THEN 00779 ICHAR=J-1 00779 ELSE 00780 ICHAR=TMP_FILIND(2) 00780 ENDIF 00780 IF(ICHAR-I.GT.39)THEN 00781 LOC_ERROR=ICHAR 00782 ASSIGN 32696 TO I32731 00783 GO TO 32731 00783 32696 CONTINUE 00784 ENDIF 00784 IF(CONT)THEN 00785 IF(ICHAR.EQ.I+1.AND.LINE(ICHAR).EQ.ASTERIC)THEN 00789 TMP_WILD=.TRUE. 00790 ELSE 00792 LEND=I+1 00793 DOWHILE(LEND.LE.ICHAR.AND.CONT) 00794 IF(LINE(LEND).GE.1HA.AND.LINE(LEND).LE.1HZ)THEN 00796 CONTINUE !OK, A-Z 00797 ELSEIF(LINE(LEND).GE.1Ha.AND.LINE(LEND).LE.1Hz)THEN 00799 CONTINUE !OK, a-z 00800 ELSEIF(LINE(LEND).GE.1H0.AND.LINE(LEND).LE.1H9)THEN 00802 CONTINUE !OK, 1-9 00803 ELSEIF(LINE(LEND).EQ.1H_)THEN 00805 CONTINUE !OK, _ 00806 ELSEIF(LINE(LEND).EQ.1H$)THEN 00808 CONTINUE !OK, $ 00809 ELSE 00811 LOC_ERROR=LEND 00812 ASSIGN 32695 TO I32731 00813 GO TO 32731 00813 32695 CONTINUE 00815 ENDIF 00815 LEND=LEND+1 00816 ENDDO 00817 ENDIF 00818 ENDIF 00819 ENDIF 00820 IF(CONT.AND.J.NE.0)THEN 00821 I=TMP_FILIND(2)-J 00825 IF(I.EQ.1.AND.LINE(J+1).EQ.ASTERIC)THEN 00827 TMP_WILD=.TRUE. 00828 ELSEIF(I.GT.0)THEN 00830 DECODE(I,6,LINE(J+1),ERR=1700)J 00831 6 FORMAT(I10) 00832 IF(J.LT.1) GO TO 1700 00833 ELSE 00835 1700 LOC_ERROR=TMP_FILIND(2) 00836 ASSIGN 32694 TO I32731 00837 GO TO 32731 00837 32694 CONTINUE 00839 ENDIF 00839 ENDIF 00840 IF(CONT)THEN 00841 I=TMP_FILIND(2)+1 00845 IF(LOC_SLASH.NE.0.AND.LOC_SLASH.EQ.I)THEN 00847 CONTINUE !OK 00848 ELSEIF(LOC_SLASH.EQ.0.AND.ISTRNG_END.EQ.I-1)THEN 00850 CONTINUE !OK 00851 ELSE 00853 LOC_ERROR=I 00854 ASSIGN 32693 TO I32731 00855 GO TO 32731 00855 32693 CONTINUE 00857 ENDIF 00857 ENDIF 00858 GO TO I32713 00859 32711 CONTINUE 00860 I=LOC_SLASH+1 00864 DOWHILE(I.LE.ISTRNG_END.AND.CONT) 00865 TST=LINE(I).EQ.LEFT_BRACKET.OR.LINE(I).EQ.RIGHT_BRACKET.OR. 00866 1 LINE(I).EQ.SEMICOLON 00867 IF(TST)THEN 00868 LOC_ERROR=I 00869 ASSIGN 32692 TO I32731 00870 GO TO 32731 00870 32692 CONTINUE 00871 ENDIF 00871 I=I+1 00872 ENDDO 00873 GO TO I32711 00874 32742 CONTINUE 00875 DOWHILE(LOC_SLASH.NE.0.AND.CONT) 00879 I_STRT_SW=LOC_SLASH+1 00883 LOCATION=LOC_SLASH+1 00884 ASSIGN 32691 TO I32748 00885 GO TO 32748 00885 32691 IF(LOC_SLASH.EQ.0)THEN 00886 I_END_SW=ISTRNG_END 00886 ELSE 00887 I_END_SW=LOC_SLASH-1 00887 ENDIF 00887 ASSIGN 32689 TO I32690 00888 GO TO 32690 00888 32689 IF(CONT.AND.LOC_COLON.NE.0)THEN 00889 ASSIGN 32687 TO I32688 00889 GO TO 32688 00889 32687 CONTINUE 00889 ENDIF 00889 ENDDO 00890 GO TO I32742 00891 32690 CONTINUE 00892 ICHAR=I_STRT_SW 00896 LEND=I_END_SW 00897 SEARCH_CHAR=COLON 00898 ASSIGN 32686 TO I32734 00899 GO TO 32734 00899 32686 LOC_COLON=ICHAR 00900 IF(ICHAR.EQ.0)THEN 00901 I=I_END_SW 00901 ELSE 00902 I=ICHAR-1 00902 ENDIF 00902 IF(LINE(I_STRT_SW).EQ.MINUS)THEN 00903 SW_NEG=.TRUE. 00904 I_STRT_SW=I_STRT_SW+1 00905 ELSE 00907 SW_NEG=.FALSE. 00907 ENDIF 00907 J=I-I_STRT_SW+1 00908 IF(J.LE.0)THEN 00910 LOC_ERROR=I 00911 ASSIGN 32684 TO I32685 00912 GO TO 32685 00912 32684 CONTINUE 00914 ELSEIF(J.EQ.1)THEN 00914 NAM(1)=LINE(I_STRT_SW) 00915 NAM(2)=0 00916 ELSE 00918 NAM(1)=LINE(I_STRT_SW) 00919 NAM(2)=LINE(I_STRT_SW+1) 00920 ENDIF 00922 IF(CONT)THEN 00923 J=1 00927 DOWHILE(.NOT.(J.GT.MAX_NUM_SW.OR.INAM.EQ.INAME(J))) 00928 J=J+1 00928 ENDDO 00928 IF(J.GT.MAX_NUM_SW)THEN 00929 LOC_ERROR=I_END_SW 00930 ASSIGN 32683 TO I32685 00931 GO TO 32685 00931 32683 CONTINUE 00933 ELSE 00933 NSW=J 00934 TMP_SW_STATE(NSW)=.NOT.SW_NEG 00935 ENDIF 00936 ENDIF 00937 GO TO I32690 00938 32685 CONTINUE 00939 TYPE 2,(LINE(I),I=1,LOC_ERROR) 00943 2 FORMAT(' CSIGO--INVALID OR IMPROPERLY SPECIFIED SW OR VALUE:',/, 00944 1 (1X,70A1)) 00945 CONT=.FALSE. 00946 GO TO I32685 00947 32688 CONTINUE 00948 NVAL=0 00952 DOWHILE(LOC_COLON.NE.0.AND.CONT) 00953 NVAL=NVAL+1 00954 TST=SW_VALUE_CHAIN(1,NSW).EQ.0.OR. 00958 1 (NVAL.GT.SW_VALUE_CHAIN(2,NSW)-SW_VALUE_CHAIN(1,NSW)+1) 00959 IF(TST)THEN 00960 LOC_ERROR=LOC_COLON 00961 ASSIGN 32682 TO I32685 00962 GO TO 32685 00962 32682 CONTINUE 00964 ELSE 00964 I_STRT_VAL=LOC_COLON+1 00968 ICHAR=I_STRT_VAL 00969 LEND=I_END_SW 00970 SEARCH_CHAR=COLON 00971 ASSIGN 32681 TO I32734 00972 GO TO 32734 00972 32681 LOC_COLON=ICHAR 00973 IF(ICHAR.EQ.0)THEN 00974 I_END_VAL=I_END_SW 00974 ELSE 00975 I_END_VAL=ICHAR-1 00975 ENDIF 00975 I=SW_VALUE_LENGTH(SW_VALUE_CHAIN(1,NSW)+NVAL-1) 00979 IF (I.LT.1.AND.I.GT.-30) THEN !861031 00981 IF (LINE(I_STRT_VAL).EQ.1H%) THEN !861031 00985 TST = LINE(I_STRT_VAL+1) !radix type !861031 00987 IF (TST.EQ.1HD .OR. TST.EQ.1Hd) THEN !861031 00988 I=I/10*10 !set to decimal I*2, 1 or 4 !861031 00989 I_STRT_VAL = I_STRT_VAL+2 !861031 00990 ELSEIF (TST.EQ.1HO .OR. TST.EQ.1Ho) THEN !861031 00991 I=I/10*10-1 !set to octal I*2, 1 or 4 !861031 00992 I_STRT_VAL = I_STRT_VAL+2 !861031 00993 ELSEIF (TST.EQ.1HX .OR. TST.EQ.1Hx) THEN !861031 00994 I=I/10*10-2 !set to hex I*2, 1 or 4 !861031 00995 I_STRT_VAL = I_STRT_VAL+2 !861031 00996 ELSE !861031 00997 I_END_VAL = I_STRT_VAL+1 !illegal radix !861031 00998 GOTO 1000 !861031 00999 ENDIF !861031 01000 ENDIF !861031 01001 ENDIF !861031 01002 IF(I_END_VAL-I_STRT_VAL.LT.0)THEN 01005 CONTINUE !NULL STRING REQUIRES NO ACTION, DEFAULT ALREADY SET 01006 ELSEIF(I.GT.0)THEN 01008 IF(I.LT.I_END_VAL-I_STRT_VAL+1)I_END_VAL=I_STRT_VAL+I-1 01012 TMP_SW_VALUE(1,SW_VALUE_CHAIN(1,NSW)+NVAL-1)=I_STRT_VAL 01013 TMP_SW_VALUE(2,SW_VALUE_CHAIN(1,NSW)+NVAL-1)=I_END_VAL 01014 ELSEIF(I.EQ.0 .OR. I.EQ.-10 .OR. I.EQ.-20)THEN 01016 DECODE(I_END_VAL-I_STRT_VAL+1,3,LINE(I_STRT_VAL),ERR=1000)J 01020 3 FORMAT(I20) !861031 01021 IF (I.EQ.0) THEN !861031 01025 IF (J.LT.-32767 .OR. J.GT.32767) GOTO 1000 !861031 01026 ELSEIF (I.EQ.-10) THEN !861031 01028 IF (J.LT.-127 .OR. J.GT.127) GOTO 1000 !861031 01029 ELSE !861031 01031 IF (J.EQ.-2147483648) GOTO 1000 !861031 01032 ENDIF 01034 TMP_SW_VALUE(1,SW_VALUE_CHAIN(1,NSW)+NVAL-1)=J 01036 ELSEIF(I.EQ.-1 .OR. I.EQ.-11 .OR. I.EQ.-21)THEN 01038 DECODE(I_END_VAL-I_STRT_VAL+1,4,LINE(I_STRT_VAL),ERR=1000)J 01042 4 FORMAT(O20) !861031 01043 IF (I.EQ.-1) THEN !861031 01047 IF (J.LT.-32767 .OR. J.GT.32767) GOTO 1000 !861031 01048 ELSEIF (I.EQ.-11) THEN !861031 01050 IF (J.LT.-127 .OR. J.GT.127) GOTO 1000 !861031 01051 ELSE !861031 01053 IF (J.EQ.-2147483648) GOTO 1000 !861031 01054 ENDIF 01056 TMP_SW_VALUE(1,SW_VALUE_CHAIN(1,NSW)+NVAL-1)=J 01058 ELSEIF(I.EQ.-2 .OR. I.EQ.-12 .OR. I.EQ.-22)THEN 01060 DECODE(I_END_VAL-I_STRT_VAL+1,15,LINE(I_STRT_VAL),ERR=1000)J 01064 15 FORMAT(Z20) !861031 01065 IF (I.EQ.-1) THEN !861031 01069 IF (J.LT.-32767 .OR. J.GT.32767) GOTO 1000 !861031 01070 ELSEIF (I.EQ.-11) THEN !861031 01072 IF (J.LT.-127 .OR. J.GT.127) GOTO 1000 !861031 01073 ELSE !861031 01075 IF (J.EQ.-2147483648) GOTO 1000 !861031 01076 ENDIF 01078 TMP_SW_VALUE(1,SW_VALUE_CHAIN(1,NSW)+NVAL-1)=J 01080 ELSE 01082 DECODE(I_END_VAL-I_STRT_VAL+1,16,LINE(I_STRT_VAL),ERR=1000)RR 01086 16 FORMAT(F20.0) !861031 01087 TMP_SW_VALUE_RR(SW_VALUE_CHAIN(1,NSW)+NVAL-1)=RR !861031 01089 ENDIF 01092 IF(.FALSE.)THEN 01093 1000 LOC_ERROR=I_END_VAL 01097 ASSIGN 32680 TO I32685 01098 GO TO 32685 01098 32680 CONTINUE 01099 ENDIF 01099 ENDIF 01100 ENDDO 01101 GO TO I32688 01102 32740 CONTINUE 01103 IF(NODIND_ADDR.NE.0)THEN 01107 CALL LIB$MOVC3 (4,TMP_NODIND(1),%VAL(NODIND_ADDR)) !861031 01108 ENDIF 01109 IF(DEVIND_ADDR.NE.0)THEN 01110 CALL LIB$MOVC3 (4,TMP_DEVIND(1),%VAL(DEVIND_ADDR)) 01111 ENDIF 01112 IF(UICIND_ADDR.NE.0)THEN 01113 CALL LIB$MOVC3 (4,TMP_UICIND(1),%VAL(UICIND_ADDR)) 01114 ENDIF 01115 IF(FILIND_ADDR.NE.0)THEN 01116 CALL LIB$MOVC3 (4,TMP_FILIND(1),%VAL(FILIND_ADDR)) 01117 ENDIF 01118 GO TO I32740 01119 32738 CONTINUE 01120 DO I=1,NUM_SW_DFN 01124 CALL LIB$MOVC3 (2,TMP_SW_STATE(I),%VAL(SW_STATE_ADDR(I))) 01125 ENDDO 01126 IF(NUM_SW_VAL_DFN.GT.0)THEN 01130 DO I=1,NUM_SW_VAL_DFN 01131 J = SW_VALUE_LENGTH(I) !861031 01132 IF (J.EQ.0 .OR. J.EQ.-1 .OR. J.EQ.-2) THEN !861031 01134 CALL LIB$MOVC3 (2,TMP_SW_VALUE(1,I),%VAL(SW_VALUE_ADDR(I)))!I*2 01135 ELSEIF (J.EQ.-10 .OR. J.EQ.-11 .OR. J.EQ.-12) THEN !861031 01137 CALL LIB$MOVC3 (1,TMP_SW_VALUE(1,I),%VAL(SW_VALUE_ADDR(I)))!I*1 01138 ELSEIF (J.EQ.-20 .OR. J.EQ.-21 .OR. J.EQ.-22) THEN !861031 01140 CALL LIB$MOVC3 (4,TMP_SW_VALUE(1,I),%VAL(SW_VALUE_ADDR(I)))!I*4 01141 ELSEIF (J.EQ.-30) THEN !861031 01143 CALL LIB$MOVC3 (4,TMP_SW_VALUE(1,I),%VAL(SW_VALUE_ADDR(I)))!R*4 01144 ELSEIF (J.EQ.-40) THEN !861031 01146 CALL LIB$MOVC3 (8,TMP_SW_VALUE(1,I),%VAL(SW_VALUE_ADDR(I)))!R*8 01147 ELSE 01149 IF(TMP_SW_VALUE(1,I).EQ.0)THEN 01153 J=0 01153 ELSE 01154 J=TMP_SW_VALUE(2,I)-TMP_SW_VALUE(1,I)+1 01154 ENDIF 01154 CALL LIB$MOVC5 (J,LINE(TMP_SW_VALUE(1,I)),0, 01155 1 SW_VALUE_LENGTH(I),%VAL(SW_VALUE_ADDR(I))) 01156 ENDIF 01157 ENDDO 01159 ENDIF 01160 GO TO I32738 01161 32736 CONTINUE 01162 IF(MORE_ADDR.NE.0)THEN 01166 CALL LIB$MOVC3 (2,TMP_MORE,%VAL(MORE_ADDR)) 01167 ENDIF 01168 IF(WILD_ADDR.NE.0)THEN 01169 CALL LIB$MOVC3 (2,TMP_WILD,%VAL(WILD_ADDR)) 01170 ENDIF 01171 IF(EQUAL_ADDR.NE.0)THEN 01172 CALL LIB$MOVC3 (2,TMP_EQUAL,%VAL(EQUAL_ADDR)) 01173 ENDIF 01174 GO TO I32736 01175 END 01176