C ***** This is the routine in the COMINT Address Program ***** C ***** that processes Start Setting Card Address Next to ***** C ***** MSB phrase in the Data Section of the Address ***** C ***** Specification file. ***** C ***** ***** C ***** COMINT Address Program Rev. 29-OCT-1992 ***** SUBROUTINE Set_CA_NT_MSM C ***************************************** C Define all Variables and Arrays C ***************************************** IMPLICIT NONE INCLUDE 'ComAdrs_Common.INC' INTEGER*2 CurrentChr INTEGER*2 This_Cell,Start_Set_Adrs INTEGER*4 Got_It,Address,Pointer,Adrs_Digit(4) LOGICAL Set_NT_MSB,Current_NT_MSB C *********************************************************************** C Advertize that processing of a Start Setting Card Address PROM C Next to MSB phrase will start. C *********************************************************************** IF ( Full_Display .EQ. 0 ) GOTO 35 WRITE ( 6, 25 ) 25 FORMAT ( /, & ' Processing of a Start Setting Card Address ' , /, & ' PROM Next to MSB phrase will now start. ' ) 35 CONTINUE C *********************************************************************** C First verify that this is a Start Setting Card Address PROM C Next to MSB phrase and then get the desired state (High or C Low) and the PROM Address where the action should start. C *********************************************************************** C Test the first characters to see if they are: C "Start Setting Card Address PROM Next to MSB" 50 IF ( ThisLine(1) .EQ. 'S' .AND. & ThisLine(2) .EQ. 'T' .AND. & ThisLine(3) .EQ. 'A' .AND. & ThisLine(4) .EQ. 'R' .AND. & ThisLine(5) .EQ. 'T' .AND. & ThisLine(6) .EQ. 'S' .AND. & ThisLine(7) .EQ. 'E' .AND. & ThisLine(8) .EQ. 'T' .AND. & ThisLine(9) .EQ. 'T' .AND. & ThisLine(10) .EQ. 'I' .AND. & ThisLine(11) .EQ. 'N' .AND. & ThisLine(12) .EQ. 'G' .AND. & ThisLine(13) .EQ. 'C' .AND. & ThisLine(14) .EQ. 'A' .AND. & ThisLine(15) .EQ. 'R' .AND. & ThisLine(16) .EQ. 'D' .AND. & ThisLine(17) .EQ. 'A' .AND. & ThisLine(18) .EQ. 'D' .AND. & ThisLine(19) .EQ. 'D' .AND. & ThisLine(20) .EQ. 'R' .AND. & ThisLine(21) .EQ. 'E' .AND. & ThisLine(22) .EQ. 'S' .AND. & ThisLine(23) .EQ. 'S' .AND. & ThisLine(24) .EQ. 'P' .AND. & ThisLine(25) .EQ. 'R' .AND. & ThisLine(26) .EQ. 'O' .AND. & ThisLine(27) .EQ. 'M' .AND. & ThisLine(28) .EQ. 'N' .AND. & ThisLine(29) .EQ. 'E' .AND. & ThisLine(30) .EQ. 'X' .AND. & ThisLine(31) .EQ. 'T' .AND. & ThisLine(32) .EQ. 'T' .AND. & ThisLine(33) .EQ. 'O' .AND. & ThisLine(34) .EQ. 'M' .AND. & ThisLine(35) .EQ. 'S' .AND. & ThisLine(36) .EQ. 'B' ) GOTO 55 C This does NOT look like the beginning of a Start Setting Card Address C PROM Next to MSB phrase. WRITE (6,53) 53 FORMAT ( /, ' Error finding a Start Setting Cards ' , /, & ' Address PROM Next to MSB string. ' , / ) GOTO 900 C This DOES look like the beginning of a Start Setting Card Address C PROM Next to MSB phrase. Find out if it is High or Low. 55 CurrentChr = 36 IF ( ThisLine(CurrentChr+1) .EQ. 'H' .AND. & ThisLine(CurrentChr+2) .EQ. 'I' .AND. & ThisLine(CurrentChr+3) .EQ. 'G' .AND. & ThisLine(CurrentChr+4) .EQ. 'H' ) Then Set_NT_MSB = .TRUE. CurrentChr = 40 GOTO 100 ENDIF IF ( ThisLine(CurrentChr+1) .EQ. 'L' .AND. & ThisLine(CurrentChr+2) .EQ. 'O' .AND. & ThisLine(CurrentChr+3) .EQ. 'W' ) Then Set_NT_MSB = .FALSE. CurrentChr = 39 GOTO 100 ENDIF WRITE (6,65) 65 FORMAT ( /, ' Error finding a HIGH or LOW in the ' , /, & ' Start Setting Card Address PROM Next ' , /, & ' to MSB string. Fatal Error ' , / ) GOTO 900 C Now verify that the next part of the phrase is the address specification. 100 IF ( ThisLine(CurrentChr+1) .EQ. 'A' .AND. & ThisLine(CurrentChr+2) .EQ. 'T' .AND. & ThisLine(CurrentChr+3) .EQ. 'A' .AND. & ThisLine(CurrentChr+4) .EQ. 'D' .AND. & ThisLine(CurrentChr+5) .EQ. 'R' .AND. & ThisLine(CurrentChr+6) .EQ. 'S' .AND. & ThisLine(CurrentChr+7) .EQ. '=' ) GOTO 130 WRITE (6,125) 125 FORMAT ( /, ' Error finding the address specification' ,/, & ' in the Start Setting Card Address PROM Next',/, & ' Next to MSB string. Fatal Error ' ,/ ) GOTO 900 130 CurrentChr = CurrentChr + 7 ASSIGN 140 TO Got_It GOTO 700 140 CONTINUE Start_Set_Adrs = Address C ***** This is the end of the Start Setting Card Address PROM ***** C ***** Next to MSB phrase (except that there may be a comment). ***** C ***** If there are more characters in this record then verify ***** C ***** that they begin with a comment indicator. If there is not ***** C ***** a comment indicator then this record has an illegal format. ***** C Are there more characters in the record? If not then start C processing this Repeat Block Statement. IF ( CurrentChr .GE. NumChr ) GOTO 165 C OK, there are more characters. Is this just a comment? IF ( ThisLine(CurrentChr + 1) .EQ. ';' ) GOTO 155 IF ( ThisLine(CurrentChr + 1) .EQ. '!' ) GOTO 155 IF ( ThisLine(CurrentChr + 1) .EQ. '*' ) GOTO 155 C This does NOT look like a comment. Thus it is an illegal format WRITE (6,153) 153 FORMAT ( /, ' Error, extra characters in the Start ' , /, & ' Setting Card Address PROM Next to MSB' , /, & ' record. Fatal Error. ' , / ) GOTO 900 C This DOES look like a comment so let's process the Repeat Block. 155 IF ( Full_Display .EQ. 0 ) GOTO 165 WRITE ( 6, 157 ) 157 FORMAT ( /, ' A comment was found at the end of the ', /, & ' Start Setting Card Address PROM Next ', /, & ' to MSB record. ' ) 165 CONTINUE C ***** Now if in full display format send to the terminal the ***** C ***** parameters that were read in this Start Setting Card ***** C ***** Address PROM Next to MSB record. ***** IF ( Full_Display .EQ. 0 ) GOTO 180 IF ( Set_NT_MSB .EQ. .TRUE. ) WRITE (6, 175) Start_Set_Adrs 175 FORMAT (/, ' Start Setting with PROM_Adrs = ', I5, /, & ' Set the next to MSB High. ' , / ) IF ( Set_NT_MSB .EQ. .FALSE. ) WRITE (6, 177) Start_Set_Adrs 177 FORMAT (/, ' Start Setting with PROM_Adrs = ', I5, /, & ' Set the next to MSB LOW. ' , / ) 180 CONTINUE C ***** Before starting to process the Card Address array verify ***** C ***** that the address specified in this record is larger than ***** C ***** the address specified in any previous Start Setting Card ***** C ***** Address PROM Next to MSB phrase. ***** IF ( Start_Set_Adrs .GT. Prev_Start_Set_Adrs ) GOTO 190 WRITE ( 6, 185 ) 185 FORMAT ( /, ' The address found in this Start Setting ', /, & ' Card Address PROM Next to MSB record ' , /, & ' is equal or smaller than the address ' , /, & ' in a previous record of the same type. ' , /, & ' This is a fatal syntax error. ' , / ) GOTO 900 190 CONTINUE C ***** Now we have all of the data necessary to process the ***** C ***** Start Setting Card Address PROM Next to MSB phrase. ***** C ***** First verify that the current value of the Card Address ***** C ***** is in the range 0:255. Then determine the starting ***** C ***** value of the next to MSB. Then set or clear the next ***** C ***** MSB if it is necessary depending on whether this ***** C ***** Start Setting Card Address PROM Next to MSB specified ***** C ***** High or Low. After this verify the the new value of ***** C ***** the Card Address is still in the range 0:255. ***** DO Pointer=Start_Set_Adrs,8191,1 This_Cell = Card_Adrs_Array(Pointer) C Check the limits on the Card Address array data. IF ( This_Cell .GT. 255 ) GOTO 920 IF ( This_Cell .LT. 0 ) GOTO 920 C Now determine the starting value of the next to the MSB. Is it set? IF ( This_Cell .GT. 127 ) This_Cell = This_Cell - 128 IF ( This_Cell .GT. 63 ) THEN Current_NT_MSB = .TRUE. ELSE Current_NT_MSB = .FALSE. ENDIF C Now change the next to the MSB if necessary. IF ( Set_NT_MSB .EQ. .TRUE. ) THEN IF ( Current_NT_MSB .EQ. .FALSE. ) THEN Card_Adrs_Array(Pointer) = Card_Adrs_Array(Pointer) + 64 ENDIF ENDIF IF ( Set_NT_MSB .EQ. .FALSE. ) THEN IF ( Current_NT_MSB .EQ. .TRUE. ) THEN Card_Adrs_Array(Pointer) = Card_Adrs_Array(Pointer) - 64 ENDIF ENDIF C Check the limits on the Card Address array data again now C that it may have been changed. IF ( Card_Adrs_Array(Pointer) .GT. 255 ) GOTO 930 IF ( Card_Adrs_Array(Pointer) .LT. 0 ) GOTO 930 ENDDO C ***** All of the parameters and the processing of this Start ***** C ***** Setting Card Address PROM Next to MSB phrase have ***** C ***** been within range and the processing has been without ***** C ***** error. Before returning set the Prev_Start_Set_Adrs ***** C ***** equal to the Start_Set_Adrs that was found and used in ***** C ***** this Start Setting Card Address PROM Next to MSB phrase. ***** C ***** This allows us to do error checking on the starting ***** C ***** address of the next Start Setting Card Address PROM ***** C ***** Next to MSB phrase that we find in the Data Section. ***** Prev_Start_Set_Adrs = Start_Set_Adrs RETURN C *********************************************************************** C Error exit because of trouble processing the C Start Setting Card Address PROM Next to MSB phrase C *********************************************************************** 900 WRITE ( 6, 905 ) 905 FORMAT ( /, & ' Illegal syntax was found in this Start ', /, & ' Setting Card Address PROM Next to MSB ', /, & ' phrase. This is a fatal error. ', /, & ' No output files will be produced. ', / ) CLOSE ( UNIT=10 ) GOTO 998 920 WRITE ( 6, 925 ) Pointer 925 FORMAT ( /, & ' Before being modified by this routine ', /, & ' an entry in the Card Address array was ', /, & ' found that was outside of the range 0:255. ', /, & ' This is at PROM Adrs =', I5 , / ) CLOSE ( UNIT=10 ) GOTO 998 930 WRITE ( 6, 935 ) Pointer 935 FORMAT ( /, & ' After being modified by this routine ', /, & ' an ENTRY in the Card Address array was ', /, & ' found that was outside of the range 0:255. ', /, & ' This is at PROM Adrs =', I5 , / ) CLOSE ( UNIT=10 ) GOTO 998 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