C     MDUMP - THIS PROGRAM DUMPS A REQUESTED PORTION OF INTEL MEMORY TO PRIME
C
C
C     THIS PROGRAM WAS WRITTEN BY FRED S. PARMENTER AT THE MASS. COLLEGE
C     OF PHARMACY, 179 LONGWOOD AVE., BOSTON, MA. 02215
C     CONTACT ME FOR ANY QUESTIONS ABOUT THE PROGRAM, NOTING ERRORS OR
C     JUST COMMENTS.
C
C     617-732-2926
C
C     APRIL 28, 1980  VERSION #3
C
C     THE PROGRAM WRITES MEMORY TO THE FILE IN A FORM WHICH CAN BE
C     READ BY MLOAD.  IN FACT THE FOLLOWING SEQUENCE OF COMMANDS
C     COMPILES A PROGRAM, LOADS IT INTO MEMORY, READS BACK
C     MEMORY (INTO ANOTHER FILE) AND THEN COMPARES FOR ACCURACY TO
C     INSURE A CORRECT LOAD
C
C     A8080 FILE
C     MLOAD *_FILE
C     MDUMP TEST
C     FILVER TEST *_FILE
C


HERE IS SOME MORE INFORMATION WHICH MIGHT BE HELPFUL:


OK, MDUMP
GO
THE PROPER COMMAND LINE IS:

OK, MDUMP TRNAME -AMLC #A -PRINT #P

WHERE TRNAME IS THE NAME OF THE FILE INTO WHICH THE DUMP
FROM THE MICRO SHOUD BE WRITTEN - THIS PARAMENTER IS THE ONLY
REQUIRED ONE - THE OTHERS NEED NOT BE SPECIFIED IF THEIR
DEFAULT VALUES ARE ACCEPTABLE
#A IS THE NUMBER OF THE AMLC LINE TO WHICH THE MICRO IS CONNECTED (10)
#P IS 1 OR 0 DEPENDING ON WHETHER OR NOT YOU WANT TO SEE THE
DATA AS IT IS READ FROM THE MICRO (1)

HERE IS A SAMPLE RUN OF DUMPING MEMORY LOCATIONS 3D00 - 3D3F

OK, MDUMP XOUT -AMLC 10 -PRINT 1
GO
H#
.XS 3D00-3D00
.S3C3D CF-CF C9-C9
.I3C40
CD27026069CD270250593E0032833C7ECDC202CDA00223DA6C3C3A833C3CFE1EDA4C3CCDD501D6C8C24A3CFF0ED8CDE80
DE8013A833C3CFE1D32833CDA6C3CC3633CFF$
.#
.H#
.G3C40
BEGINNING MEMORY LOCATION: 3D00
FINAL LOCATION: 3D3F
3D00 3D3F CDB33E0609CD9C3EDA4A3D060ACD9C3EDA1F3D147AD3E93E01CD8D3EC300
3D060BCD9C3ED22B3D1C7BD3EADBE62F1F1FE60732623FD300DBE52FE607
371707CDXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
#3C3E
.XS 3CFE-3D00
.S3C3D CF-CF C9-C9
.
      INTEGER TRNAME(16),PRINT,AMLC,PRGM(72),STATUS(2),ENDS(10),
     *DUMP(30),INSERT(3),TRLEN
      LOGICAL OK
      DATA AMLC/10/,ENDS/10*'  '/,TRLEN/16/,PRINT/1/
      DATAPRGM/'I3C40%CD27026069CD270250593E0032833C7ECDC202CDA00223DA6C
     *3C3A833C3CFE1EDA4C3CCDD5',
     *'01D6C8C24A3CFF0ED8CDE801CDE8013A833C3CFE1D32833CDA6C3CC3633CFF#'/
      CALL ATCH$$(0,0,0,0,0,ICODE)
      PRGM(3)=SHFT(PRGM(3),8,-8)+:215
      PRGM(72)=:115400
      CALL RDTK2(2,TRNAME,TRLEN,OK)
      IF(.NOT.OK)GO TO 200
      CALL OF1(2,TRNAME,TRLEN,1,$200)
      CALL RDTK1('-AMLC',5,OK,AMLC,1)
      CALL RDTK1('-PRINT',6,OK,PRINT,1)
C
C     LET'S SEE IF THE MICRO IS AT THE MONITOR LEVEL
C
      CALL INIT(AMLC,PRINT)
C
C     NOW LET'S LOAD THE MICRO WITH THE DUMP PROGRAM
C     THE BINARY VERSION IS STORED IN THE TRNAME PRGM, BUT AS THAT
C     IS PRETTY TOUGH TO READ, THE LISTING FILE IS REPRODUCED BELOW:
C
C                1                          ORG      H3C40
C     3C40       2     CD2702               CALL     LGETHX
C     3C43       3     60                   MOV H,B
C     3C44       4     69                   MOV L,C
C     3C45       5     CD2702               CALL     LGETHX
C     3C48       6     50                   MOV D,B
C     3C49       7     59                   MOV E,C
C     3C4A       8     3E00        INIT     MVI A    D0
C     3C4C       9     32833C      STORE    STA      LCOUNT
C     3C4F      10     7E                   MOV A,M
C     3C50      11     CDC202               CALL     LNMOUT
C     3C53      12     CDA002               CALL     LHILO
C     3C56      13     23                   INX H
C     3C57      14     DA6C3C               JC       LALLDONE
C     3C5A      15     3A833C               LDA      LCOUNT
C     3C5D      16     3C                   INR A
C     3C5E      17     FE1E                 CPI      D30
C     3C60      18     DA4C3C               JC       LSTORE
C               19                          SKIP     D3
C
C
C
C               20                 * ALL DONE DUMPING 30 BYTES TO THE TERMINAL
C               21                 * NOW WAIT FOR A CHARACTER FROM PRIME
C     3C63      22     CDD501      DONE30   CALL     LCI
C               23                 * LET'S SEE IF THIS IS THE 'STOPPING' CHARACTER
C     3C66      24     D6C8                 SUI      'H
C     3C68      25     C24A3C               JNZ      LINIT
C     3C6B      26     FF                   RST 7    * IT IS, SO HALT AT THE MONITOR LEVEL
C               27                          SKIP     D3
C
C
C
C               28                 * NOW DUMMY FILL WITH 'XX' S
C     3C6C      29     0ED8        ALLDONE  MVI C    'X
C     3C6E      30     CDE801               CALL     LCO
C     3C71      31     CDE801               CALL     LCO
C     3C74      32     3A833C               LDA      LCOUNT
C     3C77      33     3C                   INR A
C     3C78      34     FE1D                 CPI      D29
C     3C7A      35     32833C               STA      LCOUNT
C     3C7D      36     DA6C3C               JC       LALLDONE
C     3C80      37     C3633C               JMP      LDONE30
C     3C83      38     FF          COUNT    RST 7
C               39                          END
C        0 ERRORS
C     ASSEMBLY COMPLETED (DCK ** REV 8)
C
      ICOUNT=0
      DO 10 I=1,72
      CALL T$AMLC(AMLC,LOC(PRGM(I)),2,3,STATUS)
      ICOUNT=ICOUNT+1
      IF(ICOUNT.NE.30)GO TO 10
      ICOUNT=0
      CALL EMPTY(AMLC,PRINT,60,60)
10    CALL WAIT(.05)
      CALL EMPTY(AMLC,PRINT,0,500)
C
C     NOW START THE PROGRAM
C
      CALL STRT(AMLC,PRINT,'3C40')
C
C     NOW LET'S SEE WHAT THE USER WANTS
C
20    CALL TNOUA('BEGINNING MEMORY LOCATION: ',27)
      READ(1,30)(ENDS(I),I=1,4)
30    FORMAT(4A1)
      CALL TEST(ENDS(1),$20)
40    CALL TNOUA('FINAL LOCATION: ',16)
      READ(1,30)(ENDS(I),I=6,9)
      CALL TEST(ENDS(6),$40)
C
C     LET'S MAKE SURE THE BEGINNING LOCATION IS NOT GRREATER THAN
C     THE FINAL LOCATION
C
      DO 50 I=1,4
      IF(ENDS(I+5).GT.ENDS(I))GO TO 80
      IF(ENDS(I+5).LT.ENDS(I))GO TO 60
50    CONTINUE
C
C     THEY ARE EQUAL - THAT'S OK
C
      GO TO 80
60    WRITE(1,70)
70    FORMAT('BAD END VALUES '/
     *'BEGINNING LOCATION MUST NOT BE SMALLER THAN END LOCATION!')
      GO TO 20
C
C     EVERYTHING IS OK
C
80    CALL EMPTY(AMLC,PRINT,0,500)
      DO 90 I=1,10
      CALL T$AMLC(AMLC,LOC(ENDS(I)),1,3,STATUS)
90    CALL WAIT(.05)
      CALL EMPTY(AMLC,PRINT,10,10)
C
C     NOW LET'S OPEN THE FILE ON WHICH THE DUMPED MEMORY WILL BE WRITTEN
C
C
C     NOW WRITE THE INSERT COMMAND ON THE FILE
C
130   INSERT(1)=SHFT('I',8,-8)+SHFT(ENDS(1),8)
      INSERT(2)=SHFT(ENDS(2),8,-8)+SHFT(ENDS(3),8)
      INSERT(3)=SHFT(ENDS(4),8,-8)+:215
      CALL PRWF$$(2,1,LOC(INSERT),3,000000,JCOUNT,ICODE)
      IF(ICODE.NE.0)CALL ERRPR$(0,ICODE,0,0,0,0)
C
C     NOW WE CAN START RECEIVING THE MEMORY DUMP
C
140   CALL T$AMLC(AMLC,0,0,4,STATUS)
      CALL WAIT(.20)
      ICOUNT=STATUS(1)
      CALL T$AMLC(AMLC,0,0,4,STATUS)
      IF(ICOUNT.NE.STATUS(1))GO TO 140
      IF(ICOUNT.EQ.60)GO TO 160
      WRITE(1,150)ICOUNT
150   FORMAT('SOMETHING IS WRONG - ',I3,' CHARACHTERS'
     *' RECEIVED INSTEAD OF 60')
      GO TO 190
C
C     60 CHARACTERS RECEIVED - LET'S SEE IF 'XX' WAS THERE
C
160   CALL T$AMLC(AMLC,LOC(DUMP),60,1,STATUS)
C
C     NOW TURN ON THE PARITY BITS
C
      DO 165 I=1,30
165   DUMP(I)=OR(DUMP(I),:100200)
      IF(PRINT.NE.0)CALL TNOU(DUMP,60)
      DO 170 I=1,30
      IWORD=31-I
      IF(DUMP(IWORD).NE.'XX')GO TO 180
170   CONTINUE
C
C     THE WHOLE LINE WAS 'XX' S - NOTHING TO RECORD THEN
C
      GO TO 190
180   CALL PRWF$$(2,1,LOC(DUMP),IWORD,000000,JCOUNT,ICODE)
      IF(ICODE.NE.0)CALL ERRPR$(0,ICODE,0,0,0,0)
      IF(IWORD.NE.30)GO TO 190
      CALL T$AMLC(AMLC,LOC('A'),1,3,STATUS)
      GO TO 140
C
C     LET'S APPEND AN ESCAPE CHARACTER ON TO THE END OF THE FILE
C
190   CALL PRWF$$(2,1,LOC(:115400),1,000000,JCOUNT,ICODE)
      IF(ICODE.NE.0)CALL ERRPR$(0,ICODE,0,0,0,0)
      CALL SEARCH(4,0,1)
      CALL INIT(AMLC,PRINT)
      CALL EXIT
200   WRITE(1,210)AMLC,PRINT
210   FORMAT('THE PROPER COMMAND LINE IS:'//
     *'OK, MDUMP TRNAME -AMLC #A -PRINT #P'//
     *'WHERE TRNAME IS THE NAME OF THE FILE INTO WHICH THE DUMP'/
     *'FROM THE MICRO SHOUD BE WRITTEN - THIS PARAMENTER IS THE ONLY'/
     *'REQUIRED ONE - THE OTHERS NEED NOT BE SPECIFIED IF THEIR '/
     *'DEFAULT VALUES ARE ACCEPTABLE'/
     *'#A IS THE NUMBER OF THE AMLC LINE TO WHICH THE MICRO IS CONNEC',
     *'TED (',I2,')'/
     *'#P IS 1 OR 0 DEPENDING ON WHETHER OR NOT YOU WANT TO SEE THE',/
     *'DATA AS IT IS READ FROM THE MICRO (',I1,')')
      CALL EXIT
      END
C
C     THIS SUBROUTINE TESTS TO SEE IF THE HEX VALUE RECEIVED IS OK
C
      SUBROUTINE TEST(HEX,IRTN)
      INTEGER HEX(4)
      DO 10 I=1,4
      K=HEX(I)
      IF(K.GE.'0'.AND.K.LE.'9')GO TO 10
      IF(K.GE.'A'.AND.K.LE.'F')GO TO 10
      WRITE(1,20)I,HEX(I)
20    FORMAT('CHARACTER NUMBER ',I2, ' WHICH WAS ',A1,' IS ILLEGAL',
     *'  -  TRY AGAIN')
      GO TO IRTN
10    CONTINUE
      RETURN
      END
C
C     SUBROUTINE TO START THE MICRO AT A SPECIFIED VALUE
C
      SUBROUTINE STRT(AMLC,TERMIO,VALUE)
      INTEGER AMLC,ST(6),S(4),STATUS(2),EXCESS,TERMIO
      EQUIVALENCE(S(1),AVALUE)
      AVALUE=VALUE
      ST(1)='G'
      ST(2)=SHFT(S(1),8,-8)
      ST(3)=SHFT(S(1),-8  )
      ST(4)=SHFT(S(2),8,-8)
      ST(5)=SHFT(S(2),-8 )
      ST(6)=SHFT(:215,-8 )
C
C     LET'S MAKE SURE THE MICRO IS AT THE MONITOR LEVEL
C
      CALL MONTST(AMLC,TERMIO,ICODE)
      IF(ICODE.NE.0)GO TO 10
      CALL TNOU('MICRO NOT AT MONITOR LEVEL',26)
      CALL EXIT
10    DO 20 I=1,6
20    CALL T$AMLC(AMLC,LOC(ST(I)),1,3,STATUS)
      CALL EMPTY(AMLC,TERMIO,7,7)
      RETURN
      END
C
C
C
C     SUBROUTINE INIT
C
      SUBROUTINE INIT(AMLC,TERMIO)
      INTEGER AMLC,STATUS(2),BEGIN(19),TERMIO
      DATA BEGIN/'X S 3 D 0 0 Y S 3 C 3 D   C F   C 9 Y '/
C
C     NOW TRY TO PUT MICRO AT MONITOR LEVEL
C
10    CALL MONTST(AMLC,TERMIO,ICODE)
      IF(ICODE.NE.1)GO TO 10
C
C     NOW BEGIN RESETING MICRO
C
      ICR=SHFT(:215,-8)
      BEGIN(7)=ICR
      BEGIN(19)=ICR
      DO 25 I=1,19
      CALL T$AMLC(AMLC,LOC(BEGIN(I)),1,3,STATUS)
25    CALL WAIT(.05)
C
C     NOW READ THHE MICRO UNTIL IT STOPS SENDING
C
      CALL EMPTY(AMLC,TERMIO,19,80)
      RETURN
      END
C
C     SUBROUTINE TO TEST THAT THE MICRO IS AT THEE MONITOR LEVEL
C     THIS ROUTINE MAY NOT RETURN IF THE MICRO IS IGNORING
C     CHARACTERS COMING AT IT FROM PRIME
C
      SUBROUTINE MONTST(AMLC,TERMIO,ICODE)
      INTEGER AMLC,STATUS(2),TERMIO
      ICODE=0                /* FAILURE CODE
      JUNK='::'
10    CALL T$AMLC(AMLC,LOC('H'),1,3,STATUS)
      CALL WAIT(.13)
      CALL T$AMLC(AMLC,0,0,4,STATUS)
      IF(STATUS(1).EQ.0)GO TO 10
C
C     THE MICRO HAS STARTED TO SEND DATA
C
20    CALL T$AMLC(AMLC,LOC(JUNK),1,1,STATUS)
      IF(TERMIO.NE.0)CALL TNOUA(JUNK,1)
      CALL T$AMLC(AMLC,0,0,4,STATUS)
      IF(STATUS(1).NE.0)GO TO 20
      CALL WAIT(.2)
      CALL T$AMLC(AMLC,0,0,4,STATUS)
      IF(STATUS(1).NE.0)GO TO 20
C
C     THE MICRO HAS STOPPED SENDING DATA
C
      JUNK=SHFT(JUNK,-1,9)
      ITEST=SHFT('.',-1,9)
      IF(JUNK.NE.ITEST)RETURN
      ICODE=1                /* SUCCESS CODE
      RETURN
      END
C
C     THIS SUBROUTINE READS INFORMATION IN FROM THE MICRO'S BUFFER
C
C     IF TERMIO IS NON-ZERO IT DISPLAYS WHAT WAS READ IN
C     IF IMIN IS NON-ZERO IT WILL WAIT INDEFINITELY UNTIL IT HAS READ
C             IN AT LEAST IMIN CHARACTERS
C     IF IMIN IS ZERO IT WILL WAIT .13 SECONDS, AND IF THE INPUT BUFFER
C             IS STILL EMPTY IT WILL RETURN.  OTHERWISE IT WILL
C             WAIT UNTIL THERE IS A SILENT INTERVAL OF AT LEAST .13 SECONDS
C     IN NO CASE HOWEVER WILL MORE THAN IMAX CHARACTERS BE READ IN
C
      SUBROUTINE EMPTY(AMLC,TERMIO,IMIN,IMAX)
      INTEGER AMLC,TERMIO,STATUS(2),BUFFER(40)
      IN=0
C
C     LET'S SEE IF THERE IS A CHARACTER IN THE BUFFER
C
10    CALL T$AMLC(AMLC,0,0,4,STATUS)
      IF(STATUS(1).NE.0)GO TO 20
C
C     LET'S WAIT A BIT AND TRY AGAIN
C
      CALL WAIT(.13)
      CALL T$AMLC(AMLC,0,0,4,STATUS)
      IF(STATUS(1).NE.0)GO TO 20
      IF(IMIN.EQ.0.OR.IN.GE.IMIN)RETURN
      GO TO 10
C
C     NOW LET'S READ WHAT'S THERE BEING CAREFUL NOT TO READ MORE THAN
C     EITHER 80 CHARACTERS OR A TOTAL OF IMAX
C
20    ICOUNT=MIN0(80,IMAX-IN,STATUS(1))
      CALL T$AMLC(AMLC,LOC(BUFFER),ICOUNT,1,STATUS)
      IF(TERMIO.NE.0)CALL TNOUA(BUFFER,ICOUNT)
      IN=IN+ICOUNT
      IF(IN.EQ.IMAX)RETURN
      GO TO 10
      END
C
C     THIS SUBROUTINE WAITS X SECONDS BEFORE RETURNING
C
      SUBROUTINE WAIT(X)
      INTEGER TIM(15)
      CALL TIMDAT(TIM,15)
      Y=60*TIM(4)+TIM(5)+TIM(6)/330.
10    CALL TIMDAT(TIM,15)
      Z=60*TIM(4)+TIM(5)+TIM(6)/330.
      IF(Z-Y.GT.X)RETURN
      GO TO 10
      END
C
