C include constant definition if not defined C############################################################################### C This module contains several higher level subroutines that combine and Caugment some of the simpler instructions inherent to the prom programmer. C C byte function memchk(count,data,sum) C subroutine cmpram(begin,offset,count,data,lunout,ists) C integer function lodmem(left,right,coment,lunin,count,data) C subroutine lstmem(begin,count,data,lunout,ists) C C############################################################################### C BYTE FUNCTION MEMCHK ( COUNT, DATA, SUM ) C C############################################################################### C This function calculates the checksum of the data array DATA. DATA is a Crandom length string of ascii hex bytes. It stores data from COUNT memory Clocations, where count is an ASCII hex number. This routine returns the hex Cchecksum in SUM which is a 4 byte array. If the function cannot convert COUNT Cor any of the data in the DATA array to binary integer form, it will return Cfalse. If no errors occur, the function will return true. C############################################################################### BYTE COUNT ( 4 ), DATA ( 1 ), TEMP ( 3 ), SUM ( 4 ) BYTE HEXBIN TEMP ( 3 ) = 0 ISUM = 0 IF (.NOT.( .NOT. HEXBIN ( COUNT, ICNT ) )) GOTO 20000 memchk = ( . FALSE . ) RETURN 20000 CONTINUE LIM = ICNT * 2 I = 1 20002 IF (.NOT.( I .LE. LIM)) GOTO 20004 TEMP ( 1 ) = DATA ( I ) TEMP ( 2 ) = DATA ( I + 1 ) IF (.NOT.( .NOT. HEXBIN ( TEMP, IVAL ) )) GOTO 20005 memchk = ( . FALSE . ) RETURN 20005 CONTINUE ISUM = ISUM + IVAL 20003 I = I + 2 GOTO 20002 20004 CONTINUE CALL BINHEX ( ISUM, SUM ) memchk = ( . TRUE . ) RETURN END C SUBROUTINE CMPRAM ( BEGIN, OFFSET, COUNT, DATA, LUNOUT, ISTS ) C C############################################################################### C This function uses a space efficient algorithm to compare COUNT Cnumber of PP RAM bytes starting at address BEGIN with the data stored in Cthe array DATA(1), DATA(2), DATA(3), etc. Two parameters are used to specify Cthe address relative to the start of the PROM versus the address relative to Cthe start of MEMORY WHERE THE PROM IS LOCATED. The routine assumes that BEGIN Cis a relative address, and the absolute PROM address is calculated C by: BEGIN-OFFSET. DATA must contain the equivalent of COUNT number of bytes Cof ascii hex data. Since in ascii code, each nibble of binary memory is Crepresented as two ascii bytes, COUNT*2=length(DATA). C C Then causes the PP to output the contents of RAM (not PROM) and Cthe function compares the data with the ascii hex data passed in the Cbyte vector DATA. The function returns status in the integer status Cparameter ISTS. ISTS can return SUCCES, FAIL, HEXERR, PPERR or RCVERR. C C This routine alters the block limits: BEGDEV, BEGRAM and COUNT. COn completion, both BEGDEV and BEGRAM are reset to 0, and COUNT is set Cto the value passed in COUNT. C C The routine detects any errors and writes the errors to logical unit CLUNOUT if there are any. Also, if there are any errors, the function returns Cfalse, else the function returns true. C############################################################################### INTEGER PRMPNT, PRMCNT, CURIN BYTE HEXBIN, BEGIN ( 4 ), COUNT ( 4 ), DATA ( 1 ) BYTE ADRS ( 4 ), CNT ( 4 ), COMPAR, OFFSET ( 4 ) BYTE HEXADD, HEXSUB, ATEMP ( 6 ) C############################################################################### C Prom programmer common data C############################################################################### BYTE LINBUF ( 132 ) BYTE RAMBUF ( 100 ) COMMON / PPDATA / LINBUF, RAMBUF C############################################################################### CALL COPY ( BEGIN, ATEMP, 5 ) IF (.NOT.( .NOT. HEXSUB ( ATEMP, OFFSET, BEGIN ) .OR. .NOT. $HEXBIN ( BEGIN, PRMPNT ) .OR. .NOT. HEXBIN ( COUNT, PRMCNT ) )) $GOTO 20007 ISTS = - 3 RETURN 20007 CONTINUE CALL BEGRAM ( '0000', ISTS ) IF (.NOT.( ISTS .NE. 1 )) GOTO 20009 RETURN 20009 CONTINUE IERCNT = 0 CURIN = 100 + 1 I = 1 20011 IF (.NOT.( I .LE. PRMCNT)) GOTO 20013 IF (.NOT.( CURIN .GT. 100 )) GOTO 20014 CURIN = 1 IF (.NOT.( PRMCNT - I .GE. 50 )) GOTO 20016 INPUTL = 50 GOTO 20017 20016 CONTINUE INPUTL = PRMCNT - I + 1 20017 CONTINUE CALL BINHEX ( ( I - 1 + PRMPNT ), ADRS ) CALL BEGDEV ( ADRS, ISTS ) CALL BINHEX ( INPUTL, CNT ) CALL BLKSIZ ( CNT, ISTS1 ) IF (.NOT.( ISTS .NE. 1 .OR. ISTS1 .NE. 1 )) GOTO 20018 RETURN 20018 CONTINUE CALL LOAD ( ISTS ) CALL ODATA ( CNT, RAMBUF, ISTS ) IF (.NOT.( ISTS .NE. 1 )) GOTO 20020 RETURN 20020 CONTINUE 20014 CONTINUE INDEX = 2 * I - 1 IF (.NOT.( .NOT. COMPAR ( RAMBUF ( CURIN ), DATA ( INDEX ), 2 ) ) $) GOTO 20022 IERCNT = IERCNT + 1 CALL BINHEX ( ( I - 1 + PRMPNT ), ADRS ) IF (.NOT.( .NOT. HEXADD ( ADRS, OFFSET, ATEMP ) )) GOTO 20024 ISTS = - 3 RETURN 20024 CONTINUE WRITE ( LUNOUT, 100 ) IERCNT, ( ATEMP ( J ), J = 1, 4 ), DATA ( $INDEX ), DATA ( INDEX + 1 ), RAMBUF ( CURIN ), RAMBUF ( CURIN + 1 $ ) 100 FORMAT ( ' *error* [', I4, '] addrs: ', 4a1, ' expected: ', $2a1, ' actual:', 2a1 ) 20022 CONTINUE CURIN = CURIN + 2 20012 I = I + 1 GOTO 20011 20013 CONTINUE CALL BEGDEV ( '0000', ISTS ) CALL BLKSIZ ( PRMCNT, ISTS1 ) IF (.NOT.( ISTS .NE. 1 .OR. ISTS1 .NE. 1 )) GOTO 20026 GOTO 20027 20026 CONTINUE IF (.NOT.( IERCNT .GT. 0 )) GOTO 20028 ISTS = 0 GOTO 20029 20028 CONTINUE ISTS = 1 20029 CONTINUE 20027 CONTINUE RETURN END C SUBROUTINE LSTMEM ( BEGIN, COUNT, DATA, LUNOUT, ISTS ) C C############################################################################### C This subroutine writes the contents of the vector DATA to the logical Cunit number LUNOUT. DATA is assumed to store ascii hex data, with the high Corder ascii byte in odd numbered locations in the vector. C BEGIN is the address that corresponds to the first byte of memory to be Clisted. This address does NOT necessarily have to be relative to the start Cof the PROM, instead, it may be with respect to the entire memory. If, for Cexample a PROM resides in a block of memory starting at F800, then in order Cto get an accurate address listing, set BEGIN=F800. COUNT is the number Cof bytes to write out. Both COUNT and BEGIN must be in ascii hex format, C4 or less bytes long, and if more than 4, then the string must be terminated Cwith a null byte. The input vector, DATA must contain 2*COUNT number of ascii Ccharacters, because each memory location is represented as 2 ASCII hex Ccharacters. C The status parameter ISTS will return either SUCCES or HEXERR. C C NOTE!!!! C C This routine does perform 16 bit addition on the variable IBEG. C C############################################################################### BYTE BEGIN ( 4 ), COUNT ( 4 ), DATA ( 1 ), HEXBIN BYTE ADRS ( 4 ) C############################################################################### C Prom programmer common data C############################################################################### BYTE LINBUF ( 132 ) BYTE RAMBUF ( 100 ) COMMON / PPDATA / LINBUF, RAMBUF C############################################################################### IF (.NOT.( .NOT. HEXBIN ( BEGIN, IBEG ) .OR. .NOT. HEXBIN ( COUNT $, ICNT ) )) GOTO 20030 ISTS = - 3 RETURN 20030 CONTINUE I = 1 20032 IF (.NOT.( I .LE. ICNT)) GOTO 20034 NADD = I - 1 CALL BINHEX ( IBEG + NADD, ADRS ) IF (.NOT.( ICNT - I .GE. 16 )) GOTO 20035 LIM = 16 GOTO 20036 20035 CONTINUE LIM = ICNT - I + 1 20036 CONTINUE LINPNT = 0 CONTINUE J = 1 20037 IF (.NOT.( J .LE. LIM)) GOTO 20039 K = 2 * ( J + I - 1 ) LINBUF ( LINPNT + 1 ) = DATA ( K - 1 ) LINBUF ( LINPNT + 2 ) = DATA ( K ) LINBUF ( LINPNT + 3 ) = ' ' LINPNT = LINPNT + 3 20038 J = J + 1 GOTO 20037 20039 CONTINUE WRITE ( LUNOUT, 100 ) ( ADRS ( K ), K = 1, 4 ), ( LINBUF ( J ), J $ = 1, LINPNT ) 100 FORMAT ( 1x, 4a1, 1x, 120a1 ) 20033 I = I + 16 GOTO 20032 20034 CONTINUE ISTS = 1 RETURN END C INTEGER FUNCTION LODMEM ( LEFT, RIGHT, COMENT, LUNIN, COUNT, DATA $ ) C C############################################################################### C This function reads ASCII hex data (byte pairs) from the input logical Cunit number, LUNIN, and loads it into the byte array DATA. C This routine only scans the input record from columns LEFT to RIGHT, Cwhere both are integers. The maximum input record is LINMAX-1 bytes, so to Cscan the whole line set LEFT<=1 and RIGHT>=LINMAX. If the comment delimiter Ccharacter COMENT is located any wheres on the line, the remainder of that line Cis ignored. If there is no command delimiter character, then set COMENT=EOS. C This routine will ignore any spaces or commas in the input line. Further Cthe routine will correctly handle horizontal tabs. C Any characters other than spaces, tabs, commas or legal hexidecimal Ccharacters inside of columns LEFT and right and not to the right of a comment Cdelimiter, will cause the routine to return an error. Hex characters may Cbe in either upper or lower case. C The ascii hex byte string COUNT should indicate the number of data bytes Cthat are to be read. To read to the end of the file, specify COUNT equal to the Cone half the maximum number of ascii bytes that can be stored in the input CDATA vector. This will protect from reading data into memory not allocated to Cthe input DATA buffer. In this case the routine will only read as many bytes Cas there are in the file. On a successful read operation, the value of the Cfunction returns the number of bytes of memory (not ascii characters) that Cwere read. Again, the number of ascii bytes read equals twice the function Cvalue return. C DATA is the byte array, and it is assumed to be long enough to hold all Cof the data read in. C C function value | description C -----------------|--------------------------------- C >=0 | number of bytes of memory read C HEXERR | illegal hexidecimal value C C############################################################################### BYTE COMENT, COUNT ( 4 ), DATA ( 1 ), BITE, HEXBIN BYTE LHEX INTEGER LEFT, RIGHT, LUNIN, TABSTP INTEGER COLUMN, GETL C############################################################################### C Prom programmer common data C############################################################################### BYTE LINBUF ( 132 ) BYTE RAMBUF ( 100 ) COMMON / PPDATA / LINBUF, RAMBUF C############################################################################### IF (.NOT.( .NOT. HEXBIN ( COUNT, ICNT ) )) GOTO 20040 lodmem = ( - 3 ) RETURN 20040 CONTINUE IF (.NOT.( ICNT .EQ. 0 )) GOTO 20042 lodmem = ( 0 ) RETURN 20042 CONTINUE NBYTES = 0 20044 CONTINUE LEN = GETL ( LINBUF, 132, LUNIN ) IF (.NOT.( LEN .LT. 0 )) GOTO 20047 lodmem = ( NBYTES ) RETURN 20047 CONTINUE IF (.NOT.( LEN .EQ. 0 )) GOTO 20049 GOTO 20045 20049 CONTINUE 20048 CONTINUE COLUMN = 1 CONTINUE LINPNT = 1 20051 IF (.NOT.( LINPNT .LE. LEN .AND. LINBUF ( LINPNT ) .NE. COMENT)) $GOTO 20053 BITE = LINBUF ( LINPNT ) IF (.NOT.( BITE .EQ. ' ' )) GOTO 20054 CONTINUE TABSTP = 9 20056 IF (.NOT.( COLUMN .GE. TABSTP)) GOTO 20058 20057 TABSTP = TABSTP + 8 GOTO 20056 20058 CONTINUE COLUMN = TABSTP GOTO 20055 20054 CONTINUE IF (.NOT.( COLUMN .GT. RIGHT )) GOTO 20059 GOTO 20053 20059 CONTINUE IF (.NOT.( COLUMN .LT. LEFT )) GOTO 20061 COLUMN = COLUMN + 1 GOTO 20062 20061 CONTINUE IF (.NOT.( BITE .EQ. ' ' .OR. BITE .EQ. ',' )) GOTO 20063 COLUMN = COLUMN + 1 GOTO 20064 20063 CONTINUE IF (.NOT.( LHEX ( BITE ) .AND. LHEX ( LINBUF ( LINPNT + 1 ) ) )) $GOTO 20065 INDEX = NBYTES * 2 + 1 DATA ( INDEX ) = BITE DATA ( INDEX + 1 ) = LINBUF ( LINPNT + 1 ) LINPNT = LINPNT + 1 COLUMN = COLUMN + 2 NBYTES = NBYTES + 1 IF (.NOT.( ICNT .EQ. NBYTES )) GOTO 20067 lodmem = ( NBYTES ) RETURN 20067 CONTINUE GOTO 20066 20065 CONTINUE lodmem = ( - 3 ) RETURN 20066 CONTINUE 20064 CONTINUE 20062 CONTINUE 20060 CONTINUE 20055 CONTINUE 20052 LINPNT = LINPNT + 1 GOTO 20051 20053 CONTINUE 20045 GOTO 20044 20046 CONTINUE END C BYTE FUNCTION LHEX ( BITE ) C C############################################################################### C Returns true if the byte BITE is a legal hex character, i.e. C0-9 or 'A'-'F'. Also, if the character is lower case, the routine Cconverts it to upper case. C############################################################################### BYTE BITE IF (.NOT.( ( BITE .GE. '0' .AND. BITE .LE. '9' ) .OR. ( BITE .GE. $ 'A' .AND. BITE .LE. 'F' ) )) GOTO 20069 lhex = ( . TRUE . ) RETURN 20069 CONTINUE IF (.NOT.( BITE .GE. 'a' .AND. BITE .LE. 'f' )) GOTO 20071 BITE = BITE + 'A' - 'a' lhex = ( . TRUE . ) RETURN 20071 CONTINUE lhex = ( . FALSE . ) RETURN END