C ***** This is the routine in the COMINT Address Program ***** C ***** that processes the Address Specification Phrase ***** C ***** in the Data Section of a COMINT Address ***** C ***** Specification file. ***** C ***** ***** C ***** COMINT Address Program Rev. 8-JULY-1993 ***** SUBROUTINE Process_Address_Specification C ***************************************** C Define all Variables and Arrays C ***************************************** IMPLICIT NONE INCLUDE 'ComAdrs_Common.INC' LOGICAL Alt_Format INTEGER*2 CurrentChr INTEGER*2 PROM_Adrs,Mother_Brd_Adrs,Card_Adrs,Function_Adrs INTEGER*4 Adrs_Digit(4),Address,Got_It C *********************************************************************** C Advertize that processing of an Address Specification phrase will start C *********************************************************************** IF ( Full_Display .EQ. 0 ) GOTO 17 WRITE ( 6, 15 ) 15 FORMAT ( /, & ' Processing an Address Specification will now start. ' ) 17 CONTINUE C *********************************************************************** C First verify that this is an Address Specification Phrase and C then get the PROM Address that is being defined. C *********************************************************************** C Test the first characters to see if they are: "Adrs=" IF ( ThisLine(1) .EQ. 'A' .AND. & ThisLine(2) .EQ. 'D' .AND. & ThisLine(3) .EQ. 'R' .AND. & ThisLine(4) .EQ. 'S' .AND. & ThisLine(5) .EQ. '=' ) GOTO 25 C This does NOT look like the beginning of an Address Specification record. WRITE (6,23) 23 FORMAT ( /, ' Error finding the ADRS= string. ', / ) GOTO 900 C This DOES look like the beginning of an Address Specification record. C Test to see if the numeric format or the alternate +INC format will C be used to specify the PROM Address. 25 IF ( ThisLine(6) .EQ. '+' .AND. & ThisLine(7) .EQ. 'I' .AND. & ThisLine(8) .EQ. 'N' .AND. & ThisLine(9) .EQ. 'C' ) THEN CurrentChr = 9 Alt_Format = .TRUE. PROM_Adrs = Prev_PROM_Adrs + 1 IF ( Full_Display .EQ. 0 ) GOTO 29 WRITE ( 6, 27 ) 27 FORMAT ( & ' Alternate +INC format used to specify the PROM Adress. ') 29 CONTINUE GOTO 67 ENDIF C The alternate +INC format is not being used to specify the PROM_Adrs so C let's try to read a numeric format PROM_Adrs. To do this setup CurrentChr C and setup to call the routine to read the address. Alt_Format = .FALSE. CurrentChr = 5 ASSIGN 45 TO Got_It GOTO 700 45 CONTINUE PROM_Adrs = Address C Now because the numeric format was used we need to verify that, if the C previous Address Specification Phrase used the alternate +INC format, C that this current standard numeric format Address Specification Phrase C contains a PROM_Adrs that is 1 greater than the PROM_Adrs generated C in the previous alternate +INC format Address Specification Phrase. IF ( Alt_Format .EQ. .FALSE. .AND. & Prev_Format .EQ. .TRUE. ) THEN IF ( PROM_Adrs .EQ. Prev_PROM_Adrs + 1 ) GOTO 67 WRITE ( 6, 55 ) PROM_Adrs 55 FORMAT ( /, ' Error in PROM_Adrs after +INC format spec. ', & /, ' PROM_Adrs is = ', I4, ' Fatal Error. ', / ) GOTO 900 ENDIF C OK, we now have the PROM_Adrs (either by numeric or else +INC format) C so go ahead and check that it is a legal PROM_Adrs and that it has C not been specified before. 67 IF ( PROM_Adrs .LT. 0 ) GOTO 70 IF ( PROM_Adrs .GT. 8191 ) GOTO 70 GOTO 80 70 WRITE ( 6, 75 ) 75 FORMAT ( /, ' PROM Address out of range error. ', / ) GOTO 900 80 IF ( Only_Once(PROM_Adrs) .EQ. .TRUE. ) GOTO 90 WRITE ( 6, 85 ) PROM_Adrs 85 FORMAT ( /, ' Duplicate PROM Address specification. ', /, & ' PROM_Adrs is = ', I4, ' Fatal Error. ', / ) GOTO 900 90 Only_Once(PROM_Adrs) = .FALSE. C ***** Now check and then get the Mother Board Address ***** C Test the next 5 characters to see if they are: ",MBA=" 150 IF ( ThisLine(CurrentChr+1) .EQ. ',' .AND. & ThisLine(CurrentChr+2) .EQ. 'M' .AND. & ThisLine(CurrentChr+3) .EQ. 'B' .AND. & ThisLine(CurrentChr+4) .EQ. 'A' .AND. & ThisLine(CurrentChr+5) .EQ. '=' ) GOTO 155 C This does NOT look like the beginning of the Mother Board Address. WRITE (6,153) 153 FORMAT ( /, ' Error finding the ,MBA= string. ', / ) GOTO 900 C This DOES look like the beginning of the Mother Board Address. C So setup CurrentChr and setup to call the routine to read the address. 155 CurrentChr = CurrentChr + 5 ASSIGN 160 TO Got_It GOTO 700 160 CONTINUE Mother_Brd_Adrs = Address IF ( Mother_Brd_Adrs .EQ. 0 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 57 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 65 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 66 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 68 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 71 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 105 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 106 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 129 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 130 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 132 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 135 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 153 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 154 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 169 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 170 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 172 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 175 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 177 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 201 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 202 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 204 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 207 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 209 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 225 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 228 ) GOTO 180 IF ( Mother_Brd_Adrs .EQ. 249 ) GOTO 180 WRITE ( 6, 175 ) 175 FORMAT ( /, ' Mother Board Address out of range error. ', / ) GOTO 900 180 CONTINUE C ***** Now check and then get the CARD Address ***** C Test the next 3 characters to see if they are: "CA=" 250 IF ( ThisLine(CurrentChr+1) .EQ. 'C' .AND. & ThisLine(CurrentChr+2) .EQ. 'A' .AND. & ThisLine(CurrentChr+3) .EQ. '=' ) GOTO 255 C This does NOT look like the beginning of the Card Address. WRITE (6,253) 253 FORMAT ( /, ' Error finding the CA= string. ', / ) GOTO 900 C This DOES look like the beginning of the Card Address. C So setup CurrentChr and setup to call the routine to read the address. 255 CurrentChr = CurrentChr + 3 ASSIGN 260 TO Got_It GOTO 700 260 CONTINUE Card_Adrs = Address IF ( Card_Adrs .EQ. 64 ) GOTO 280 IF ( Card_Adrs .EQ. 128 ) GOTO 280 IF ( Card_Adrs .EQ. 192 ) GOTO 280 IF ( Card_Adrs .LT. 0 ) GOTO 270 IF ( Card_Adrs .GT. 63 ) GOTO 270 GOTO 290 270 WRITE ( 6, 275 ) 275 FORMAT ( /, ' Card Address out of range error. ', / ) GOTO 900 280 WRITE ( 6, 285 ) PROM_Adrs,Card_Adrs 285 FORMAT ( /, & ' Caution A Special Card Address has been specified. ', /, & ' The PROM_Adrs is = ', I4, /, & ' The Card_Adrs is = ', I3, / ) 290 CONTINUE C ***** Now check and then get the FUNCTION Address ***** C Test the next 3 characters to see if they are: "FA=" 350 IF ( ThisLine(CurrentChr+1) .EQ. 'F' .AND. & ThisLine(CurrentChr+2) .EQ. 'A' .AND. & ThisLine(CurrentChr+3) .EQ. '=' ) GOTO 355 C This does NOT look like the beginning of the Function Address. WRITE (6,353) 353 FORMAT ( /, ' Error finding the FA= string. ', / ) GOTO 900 C This DOES look like the beginning of the Function Address. C So setup CurrentChr and setup to call the routine to read the address. 355 CurrentChr = CurrentChr + 3 ASSIGN 360 TO Got_It GOTO 700 360 CONTINUE Function_Adrs = Address IF ( Function_Adrs .LT. 0 ) GOTO 370 IF ( Function_Adrs .GT. 255 ) GOTO 370 GOTO 380 370 WRITE ( 6, 375 ) 375 FORMAT ( /, ' Function Address out of range error. ', / ) GOTO 900 380 CONTINUE C ***** Now make the entries in the address arraies ***** Mother_Brd_Adrs_Array(PROM_Adrs) = Mother_Brd_Adrs Card_Adrs_Array(PROM_Adrs) = Card_Adrs Function_Adrs_Array(PROM_Adrs) = Function_Adrs C ***** Now if in full display format send to the terminal the ***** C ***** parameters that were read in the Address Spec record. ***** IF ( Full_Display .EQ. 0 ) GOTO 435 WRITE (6, 425) PROM_Adrs,Mother_Brd_Adrs,Card_Adrs,Function_Adrs 425 FORMAT (/, ' The PROM_Adrs is = ', I4, & ' The Mother_Brd_Adrs is = ', I3, /, & ' The Card_Adrs is = ', I3, & ' The Function_Adrs is = ', I3, / ) 435 CONTINUE C ***** Test to see if there are more characters in this ***** C ***** Address Specification record. If there are more ***** C ***** characters it may be a comment or it may be illegal format. ***** C ***** If no more character in the record then just return. ***** C ***** If next character is a comment indicator then return. ***** C ***** If there are more characters but they are not a comment ***** C ***** then this is an illegal format. ***** C Are there more characters in the record? If not then return. IF ( CurrentChr .GE. NumChr ) GOTO 850 C OK, there are more characters. Is this just a comment? IF ( ThisLine(CurrentChr + 1) .EQ. ';' ) GOTO 810 IF ( ThisLine(CurrentChr + 1) .EQ. '!' ) GOTO 810 IF ( ThisLine(CurrentChr + 1) .EQ. '*' ) GOTO 810 C This does NOT look like a comment. Thus it is an illegal format WRITE (6,803) 803 FORMAT (/,' Error extra characters in Adrs Spec record.', /) GOTO 900 C This DOES look like a comment so let's return 810 IF ( Full_Display .EQ. 0 ) GOTO 820 WRITE ( 6, 815 ) 815 FORMAT ( /, ' Found a comment in a Address Specification. ' ) 820 CONTINUE GOTO 850 C Advertize that this is a normal exit from the Address Specification C processing routine. Before making the return; assign the current C values for Prev_PROM_Adrs and Prev_Format. These will be used when C processing the next Address Specification Phrase. C Then return to the calling routine. 850 IF ( Full_Display .EQ. 0 ) GOTO 860 WRITE ( 6, 855 ) 855 FORMAT ( /, & ' Normal exit from Address Specification routine. ', / ) 860 CONTINUE Prev_PROM_Adrs = PROM_Adrs Prev_Format = Alt_Format RETURN C *********************************************************************** C Error exit because of trouble processing an Address Specification C *********************************************************************** 900 WRITE ( 6, 905 ) 905 FORMAT ( /, & ' Illegal syntax was found in this Address ', /, & ' Specification Phrase. This is a fatal error. ', /, & ' No output files will be produced. ', / ) CLOSE ( UNIT=10 ) 998 WRITE ( 6, 999 ) 999 FORMAT ( / ' COMINT Address Program will now exit. ', // ) STOP ' ' C ***** This is the routine that can read the address specified ***** C ***** in the COMINT Address Specification File. This may be ***** C ***** either the PROM, Mother Board, Card, or Function address. ***** C ***** This address number may be 1, 2, 3, or 4 digits long. ***** C ***** The CurrentChr pointer must be pointing at the character ***** C ***** that is just in front (to the left) of the first digit ***** C ***** (most significant) of the number to be read. This routine ***** C ***** exits with the CurrentChr pointing to the last digit of ***** C ***** the number that was read. The symbol Got_It must be ***** C ***** Assigned to the retun label before this routine is called. ***** C ***** The limits on the address number that is returned to the ***** C ***** calling routine are not checked in this routine. ***** 700 IF ( ICHAR( ThisLine(CurrentChr + 1) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 1) ) .LE. '39'X .AND. & ICHAR( ThisLine(CurrentChr + 2) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 2) ) .LE. '39'X .AND. & ICHAR( ThisLine(CurrentChr + 3) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 3) ) .LE. '39'X .AND. & ICHAR( ThisLine(CurrentChr + 4) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 4) ) .LE. '39'X ) GOTO 754 IF ( ICHAR( ThisLine(CurrentChr + 1) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 1) ) .LE. '39'X .AND. & ICHAR( ThisLine(CurrentChr + 2) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 2) ) .LE. '39'X .AND. & ICHAR( ThisLine(CurrentChr + 3) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 3) ) .LE. '39'X ) GOTO 753 IF ( ICHAR( ThisLine(CurrentChr + 1) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 1) ) .LE. '39'X .AND. & ICHAR( ThisLine(CurrentChr + 2) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 2) ) .LE. '39'X ) GOTO 752 IF ( ICHAR( ThisLine(CurrentChr + 1) ) .GE. '30'X .AND. & ICHAR( ThisLine(CurrentChr + 1) ) .LE. '39'X ) GOTO 751 WRITE (6,725) 725 FORMAT ( /, ' Error in numeric string. ', / ) GOTO 900 C There is ONE digit of Address Number 751 Adrs_Digit(1) = 0 Adrs_Digit(2) = 0 Adrs_Digit(3) = 0 Adrs_Digit(4) = ( ICHAR( ThisLine(CurrentChr + 1) ) ) - '30'X CurrentChr = CurrentChr + 1 GOTO 760 C There are TWO digits of Address Number 752 Adrs_Digit(1) = 0 Adrs_Digit(2) = 0 Adrs_Digit(3) = ( ICHAR( ThisLine(CurrentChr + 1) ) ) - '30'X Adrs_Digit(4) = ( ICHAR( ThisLine(CurrentChr + 2) ) ) - '30'X CurrentChr = CurrentChr + 2 GOTO 760 C There are THREE digits of Address Number 753 Adrs_Digit(1) = 0 Adrs_Digit(2) = ( ICHAR( ThisLine(CurrentChr + 1) ) ) - '30'X Adrs_Digit(3) = ( ICHAR( ThisLine(CurrentChr + 2) ) ) - '30'X Adrs_Digit(4) = ( ICHAR( ThisLine(CurrentChr + 3) ) ) - '30'X CurrentChr = CurrentChr + 3 GOTO 760 C There are FOUR digits of Address Number 754 Adrs_Digit(1) = ( ICHAR( ThisLine(CurrentChr + 1) ) ) - '30'X Adrs_Digit(2) = ( ICHAR( ThisLine(CurrentChr + 2) ) ) - '30'X Adrs_Digit(3) = ( ICHAR( ThisLine(CurrentChr + 3) ) ) - '30'X Adrs_Digit(4) = ( ICHAR( ThisLine(CurrentChr + 4) ) ) - '30'X CurrentChr = CurrentChr + 4 GOTO 760 C Now put together the 4 Address Digits to make the Address number 760 Address = ( Adrs_Digit(1) * 1000 ) + $ ( Adrs_Digit(2) * 100 ) + $ ( Adrs_Digit(3) * 10 ) + $ ( Adrs_Digit(4) * 1 ) GOTO Got_It C ***** This is the end of the routine that reads a 1, 2, 3, or 4 ***** C ***** digit Address number. ***** END