FTN4,L
      PROGRAM AMROM(3)
C 
C 
C  AMROM - VERSION 1.0 - JULY 21,1977 
C 
C  AMROM HAS TWO MODES OF OPERATION:
C    1) OUTPUT
C    2) VERIFY
C 
C    1) OUTPUT MODE:
C       AMROM READS BINARY OBJECT CODE AS INPUT AND RE-FORMATS
C       IT TO HEX SO THAT ADVANCED MICRO DEVICES WILL ACCEPT
C       IT FOR THEIR ROM MASK PROCESS FOR THE AM9216. 
C       THE OUTPUT IS NORMALLY WRITTEN ON CARDS SINCE THAT IS 
C       THE ONLY MEDIA ADVANCED MICRO DEVICES WILL ACCEPT.
C 
C       THE BINARY OBJECT CODE MAY BE FROM PAPER TAPE OR FROM 
C       CARTRIDGE TAPE THAT WAS PREVIOUSLY CREATED BY THE 
C       8080 CROSS-ASSEMBLER.  AMROM EXPECTS TO READ 2K BYTES 
C       OF BINARY CODE TO BE RE-FORMATTED FOR EACH ROM PATTERN. 
C 
C    2) VERIFY MODE:
C       AMROM READS THE CARD DECK RETURNED BY ADVANCED MICRO
C       DEVICES AS A VERIFICATION STEP AND COMPARES IT AGAINST
C       THE ORIGINAL BINARY OBJECT CODE. ANY DIFFERENCES ARE
C       LISTED ON THE CURRENT LIST DEVICE.
C 
C 
C  GET PARAMETERS FROM :TR AND :RU COMMANDS 
C 
C    :TR,AMHEX,BINARY INPUT,LIST,OUTPUT,CARD INPUT
C 
C    WHERE AMHEX: 
C 
C    :RU,AMROM,BIN INPUT,LIST,OUTPUT,CARD INP,GLOBAL VAR 0
C 
C    WHERE INPUT = LU WHERE BINARY RESIDES FOR READING
C          (LOGINP)  DURING OUTPUT PHASE
C                    DEFAULT = 5
C 
C          LIST  = LU WHERE ERROR MESSAGES WILL BE
C          (LOGLIS)  PRINTED DURING VERIFY
C                    DEFAULT = 6
C 
C          OUTPUT= LU WHERE HEX WILL BE WRITTEN DURING
C          (LOGHEX)  THE TRANSLATION FROM BINARY TO HEX 
C                    DEFAULT = 8
C 
C          CARD  = LU WHERE HEX IS READ FROM DURING VERIFY
C          INPUT     PHASE
C          (LOGCRD)  DEFAULT = 7
C 
C 
       INTEGER HEX(16),ZERO 
       DIMENSION IDBUF(140),IBYTE(256),ICARD(80)
       INTEGER PART(8)
      INTEGER IPAR(5) 
      COMMON IERR,LOGLIS
       DATA IADDR/0/
       DATA LINE/0/ 
       DATA ICRDLU/9/ 
       DATA LOGIN,LPR/1,6/
       DATA INSAD,ITPR,LF,LOGOUT,MTAPE,ZERO/
     1  0,69,12B,1,8,1H0/ 
       DATA HEX/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,
     1  1H8,1H9,1HA,1HB,1HC,1HD,1HE,1HF/
       DATA ICARD/80*2H  /
       DATA IPNC/4/ 
      DATA LOGOPR,LOGINP,LOGHEX,LOGCRD/1,5,8,7/ 
      CALL RMPAR(IPAR)
      LOGLIS = 6
C 
      IF (IPAR(1) .EQ. 99) GO TO 20 
      IF (IPAR(1) .LE. 1) GO TO 15
        IF (IPAR(1) .NE. IPAR(5)) LOGINP=IPAR(1)
C 
15    CONTINUE
      IF (IPAR(2) .EQ. 99) GO TO 20 
        IF (IPAR(2) .GT. 0) LOGLIS=IPAR(2)
      IF (IPAR(3) .EQ. 99) GO TO 20 
        IF (IPAR(3) .GT. 0) LOGHEX=IPAR(3)
      IF (IPAR(4) .EQ. 99) GO TO 20 
        IF (IPAR(4) .GT. 0) LOGCRD=IPAR(4)
C 
20    CONTINUE
C 
C  GET LU OF USER TERMINAL
C    DONE VIA GLOBAL VARIABLE 0 IN :RU COMMAND
C 
      IF (IPAR(5) .GT. 0) LOGOPR=IPAR(5)
C 
      ITPR=LOGINP+100B+2000B
C 
C  DETERMINE IF PAPER TAPE OR 2645 CTU'S
C 
C    LOGCTU=0 => PAPER TAPE INPUT 
C 
      LOGCTU=0
      CALL EXEC(13,LOGINP,IEQT5,IEQT4)
      IF (IAND(IEQT5,37400B) .EQ. 2400B) LOGCTU=1 
C 
25    CONTINUE
C 
C 
C 
       IERR = 0 
      WRITE (LOGOPR,30) 
30     FORMAT(" VERIFY(V) OR OUTPUT TAPE(O)?")
      READ (LOGOPR,40) ITYPE
40     FORMAT(1A1)
       GO TO 75 
C      DO FIRST/NEXT ROM
60     CONTINUE 
      WRITE (LOGOPR,70) 
70     FORMAT(" END?  YES(Y) OR NO(N)") 
      READ (LOGOPR,40) IEND 
       IF (IEND .EQ. 1HY) STOP
75     CONTINUE 
      WRITE (LOGOPR,78) 
78     FORMAT(" SKIP NEXT 2K ON INPUT TAPE?  YES(Y) OR NO(N)")
      READ (LOGOPR,40) ISKIP
       IF (ISKIP.EQ.1HY) GO TO 95 
       IF (ITYPE.EQ.1HV) GO TO 95 
      WRITE (LOGOPR,80) 
80     FORMAT(" PART #?"/" (TYPE 8 CHARACTERS, NO EMBEDDED SPACES)")
      READ (LOGOPR,90) PART 
90     FORMAT(8A1)
C 
C MAIN LOOP. PROCESS 256 BYTRES OF
C BINARY DATA 8 TIMES 
C 
95     CONTINUE 
       DO 400 ILOOP = 1,8 
C 
C SKIP OVER ANY LEADING INFO
C ON TAPE TO ADDRESS AND DATA 
C 
C 
      IF (LOGCTU .EQ. 0) GO TO 199
C 
C  GET INPUT FROM CARTRIDGE TAPES 
C 
100   CONTINUE
        CALL EXEC(1,ITPR,IDBUF,-134)
        IF (IDBUF(1) .NE. -1) GO TO 100 
          IF (ISKIP .EQ. 1HY) GO TO 167 
            IF (IAND(IDBUF(2),3777B) .EQ. IADDR) GO TO 160
              WRITE(LOGOPR,159) IDBUF(2),IADDR
159           FORMAT(" *** ERROR *** MISSING BLOCK ADDRESS ", 
     1             O6," , ",O6) 
            STOP
C 
160     CONTINUE
        ISUM=IAND(IDBUF(2),377B)+(IDBUF(2)/256) 
C 
        DO 165 I=3,66 
          IBYTE(2*I-4)=IAND(IDBUF(I),377B)
          IF (IDBUF(I) .LT. 0) IBYTE(2*I-5)=
     1      IAND(NOT(NOT(IDBUF(I))/256),377B) 
          IF (IDBUF(I) .GE. 0) IBYTE(2*I-5)=IDBUF(I)/256
          ISUM = IAND(ISUM+IBYTE(2*I-5),377B) 
          ISUM = IAND(ISUM+IBYTE(2*I-4),377B) 
165     CONTINUE
C 
        IF (ISUM .EQ. IDBUF(67)) GO TO 167
          WRITE(LOGOPR,180) IDBUF(2),IADDR
          STOP
C 
167     CONTINUE
C 
        CALL EXEC(1,ITPR,IDBUF,-134)
        IF (ISKIP .EQ. 1HY) GO TO 400 
          IF (IAND(IDBUF(2),3777B) .EQ. IADDR+128) GO TO 170
            WRITE(LOGOPR,159) IDBUF(2),IADDR
            STOP
C 
170     CONTINUE
        ISUM=IAND(IDBUF(2),377B)+(IDBUF(2)/256) 
C 
        DO 175 I=3,66 
          IBYTE(128+(2*I-4))=IAND(IDBUF(I),377B)
          IF (IDBUF(I) .LT. 0) IBYTE(128+(2*I-5)) = 
     1      IAND(NOT(NOT(IDBUF(I))/256),377B) 
          IF (IDBUF(I) .GE. 0) IBYTE(128+(2*I-5))=IDBUF(I)/256
          ISUM = IAND(ISUM+IBYTE(128+(2*I-5)),377B) 
          ISUM = IAND(ISUM+IBYTE(128+(2*I-4)),377B) 
175     CONTINUE
C 
        INSAD=0 
        IF (ISUM .EQ. IDBUF(67)) GO TO 300
          WRITE(LOGOPR,180) IDBUF(2),IADDR
180       FORMAT(" CHECKSUM ERROR AT ",O6," ,",O6)
          STOP
199   CONTINUE
C 
C  PAPER TAPE INPUT 
C 
1990  CONTINUE
      CALL EXEC(1,ITPR,IDBUF,-1)
      IF (IDBUF(1)/256 .NE. LF) GO TO 1990
C 
1992  CONTINUE
      CALL EXEC(1,ITPR,IDBUF,1) 
      IF (IDBUF(1) .NE. -1) GO TO 1992
C READ ADDRESS, DATA, AND CHECKSUM
C 
       CALL EXEC(1,ITPR,IDBUF,-260) 
       IF (ISKIP.EQ.1HY) GO TO 400
C NEXT SEQUENTIAL STARTING ADDRESS? 
C    IF NOT, DATA ALL ZEROES
       IF(IAND(IDBUF(1),3777B).EQ.IADDR) GO TO 200
      WRITE (LOGOPR,159) IDBUF(1), IADDR
      STOP
C CONVERT DATA TO ONE BYTE/WORD 
C    CHECK CHECKSUM 
200    CONTINUE 
       INSAD=0
       ISUM=IAND(IDBUF(1),377B)+(IDBUF(1)/256)
       DO 250 I=2,129 
       IBYTE(2*I-2)=IAND(IDBUF(I),377B) 
       IF(IDBUF(I).LT.0) IBYTE(2*I-3) = 
     1  IAND(NOT(NOT(IDBUF(I))/256),377B) 
       IF(IDBUF(I).GE.0)IBYTE(2*I-3)=IDBUF(I)/256 
       ISUM=IAND(ISUM+IBYTE(2*I-3),377B)
       ISUM=IAND(ISUM+IBYTE(2*I-2),377B)
250    CONTINUE 
       IF(ISUM.EQ.IDBUF(130))GO TO 300
      WRITE (LOGOPR,270)
270    FORMAT(" CHECKSUM ERROR")
       STOP 
C 
C FROMAT DATA ON "CARDS"
C 
300    CONTINUE 
C 
C PROCESS 16 DATA BYTES - 16 TIMES
C 
       IPTR = 1 
       DO 395 IDATA = 1,16
C 
C DO ONE DATA CARD
C 
C   ADDRESS FIRST 
C 
       IVAL=IADDR/16
       IF (ITYPE.EQ.1HO) GO TO 320
      READ (LOGCRD,360) ICARD 
       LINE = LINE+1
C CHECK ADDRESS 
       ICOL = 21
       CALL  BNHEX(ICARD(21),ICARD(22),IBIN)
       IF (IVAL.NE.IBIN) CALL DIFF(LINE,ICOL, 
     1  ICARD)
       IF(ICARD(23).NE.ZERO)
     1  CALL DIFF(LINE,ICOL,ICARD)
       GO TO 330
320    CONTINUE 
       IMSB=IVAL/16 
       ILSB=IAND(IVAL,17B)
C 
       ICARD(21)= HEX(IMSB+1) 
       ICARD(22)= HEX(ILSB+1) 
       ICARD(23)= ZERO
330    CONTINUE 
C  SET DATA 
       ICOL= 30 
       DO 350 I=1,16
       IVAL = IBYTE(IPTR) 
       IF(INSAD.EQ.1) IVAL = 0
       IF (ITYPE.EQ.1HO) GO TO 340
C CHECK CARD VALUE
       CALL  BNHEX(ICARD(ICOL),ICARD(ICOL+1),IBIN)
       IF (IVAL.NE.IBIN)
     1  CALL DIFF(LINE,ICOL,ICARD)
       GO TO 345
340    CONTINUE 
       IMSB = IVAL/16 
       ILSB = IAND(IVAL,17B)
       ICARD(ICOL)= HEX(IMSB+1) 
       ICARD(ICOL+1)= HEX(ILSB+1) 
C 
345    CONTINUE 
       IPTR=IPTR+1
       ICOL = ICOL+3
350    CONTINUE 
C 
       IF (ITYPE .EQ. 1HV) GO TO 390
C      SET PART NO..
       IDASH = 0
       DO 355 L = 1,8 
       ICARD(L+IPNC+IDASH) = PART(L)
       IF (L .EQ. 4) IDASH = 1
355    CONTINUE 
      WRITE (LOGHEX,360) ICARD
360    FORMAT(80A1) 
C BUMP TO NEXT ADDRESS
390    CONTINUE 
       IADDR=IADDR+16 
395    CONTINUE 
400    CONTINUE 
       IF (ISKIP .EQ. 1HY) GO TO 60 
       IF (ITYPE.EQ.1HO) GO TO 450
C LOG # OF ERRORS 
      WRITE (LOGOPR,420) IERR 
420    FORMAT(5X,I4,"  ERRORS IN VERIFY") 
       IADDR = 0
       IERR = 0 
       LINE = 0 
       GO TO 60 
450    CONTINUE 
C 
C WRITE END OF FILE OR SKIP IT
C 
      ENDFILE LOGHEX
       IADDR = 0
       GO TO 60 
       END
       SUBROUTINE  BNHEX(HEX1,HEX2,IBIN)
C      HEX1 = HEX DIGIN, MSB
C      HEX2 = HEX DIGIT, LSB
C      IBIN = CONVERTED BINARY BYTE 
       INTEGER HEX(16),HEX1,HEX2
       DATA HEX/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,
     1  1H8,1H9,1HA,1HB,1HC,1HD,1HE,1HF/
       DO 100 I = 1,16
       IF (HEX1.EQ.HEX(I)) GO TO 120
100    CONTINUE 
       IBIN = -1
       RETURN 
120    CONTINUE 
       IBIN = 16*(I-1)
       DO 200 I = 1,16
       IF (HEX2 .EQ. HEX(I)) GO TO 220
200    CONTINUE 
       IBIN = -1
       RETURN 
220    CONTINUE 
       IBIN = IBIN + I - 1
       RETURN 
       END
       SUBROUTINE DIFF(LINE,ICOL,ICARD) 
C ERROR IN VERIFY 
C PRINT ERROR MESSAGE 
C LINE = LINE # OF ERROR
C ICOL = COLUMN # 
C ICARD = WRONG CARD IMAGE
       DIMENSION ICARD(80)
      COMMON IERR,LOGLIS
       DATA LPR/6/
       IERR = IERR+1
      WRITE (LOGLIS,380) LINE,ICOL,ICARD
380    FORMAT(" ERROR:  CARD # ",I3,", COLUMN # ",
     1  I3/1X,80A1/)
       RETURN 
       END
$END
