/FILE SYSPUNCH NAME($Y65:Y6502F.OBJ) NR(4000) NEW(REPLACE)
/SYS REGION=700K
/INCLUDE FORTG
/OPT DECK
/JOB NOGO
C     ******************************************************************
C     *                                                                *
C     *                 Y 6 5 0 2    S I M U L A T O R                 *
C     *                                                                *
C     *                     (c) Peter Coghlan 1991                     *
C     *                                                                *
C     *                converted from the Z80 Simulator                *
C     *             (c) Peter Coghlan & Niall Downey 1988              *
C     *                                                                *
C     ******************************************************************
C
C     This is a 6502 simulator which reads in hexadecimal machine code
C     from a file which is VC and records less than 105 characters long
C     and has a # in the second position of each line and an & as the
C     third last character on each line. The file may be terminated
C     with a $ in the second position of the last line.
C     Options to be used by the simulator can be passed to the program
C     on the command line when it is called, these options are,
C
C     name1 IN name2 OUT name3 LIST name4 NMI nnn IRQ nnn EX nnnn DEBUG
C
C     Where 'name1' is the name of the hexadecimal machine code file,
C           'name2' is the name of a file from which input data is read,
C           'name3' is the name of a file to which output data goes,
C           'name4' is the name of a trace file,
C           NMI nnn causes NMI's every nnn instructions,
C           IRQ nnn causes IRQ's every nnn instructions,
C           EX nnnn starts the machine code program at address nnnn hex.
C           DEBUG enables screen assembly listing and trace file
C     The name of the machine code file must be specified i.e. 'name1',
C
C     Initialise variables and 'memory'
C
      IMPLICIT INTEGER (A-Z,$)
      INTEGER POS(104),FLAGS*2(7),OPTLEN(7),TRAP(2)
      LOGICAL*1 OPCSTR(3),OPDSTR(9),BUFFER(104),PREFIX,DESC(3,5)
      LOGICAL*1 PFILE(22),IPFILE(22),OPFILE(22),SCRFLE(22),OPTS(29)
      LOGICAL*1 ADDSTR(8),DATSTR(8),PCODE(8)
      LOGICAL*1 INPUT(48)
      LOGICAL COND,IPFLAG,OPFLAG,EQUAL,EQUALB,FLAG
      LOGICAL BRANCH,EXTEND,FOUND,DEBUG,ORGFLG,EXFLAG,GOTMEM(2),BADFRM
      COMMON /COUNT/ BYTES
      COMMON /REGS/ A,X,Y,P,PC,S
      COMMON /TRAPS/ TRAP
      DATA NMICNT,IRQCNT,NMI,INT/4*0/
C
      DATA PFILE,IPFILE/22*' ','Y','6','5','0','2','.','I','N',14*' '/
      DATA OPFILE/'Y','6','5','0','2','.','O','U','T',13*' '/
      DATA OPTS/'NMI IRQ OUT IN EX LIST DEBUG '/
      DATA DESC /'O','P','S','Y','S','I','O',' ',' ',' ','M','O','D','E'
     +/
      DATA BUFFER /' '/, OPTLEN /4,4,4,3,3,5,6/
      DATA IPFLAG,OPFLAG/2*.FALSE./
      DATA ORGFLG,EXFLAG,GOTMEM,BADFRM /5*.FALSE./
      DATA DESCS /3/
      A=0
      X=0
      Y=0
      P=32
      S=0
      TRAP(1)=-1
      TRAP(2)=-1
C
      CALL REREAD
      CALL NPRMPT
C
C ######################################################################
C
C     Get option parameters from command line.
C
      CALL PARM(BUFFER,80,LEN)
      IF (LEN.NE.0) GOTO 2
        WRITE(6,1000)
 1000   FORMAT(/' *Error : program file not specified')
        CALL EOJ(80)
 2    BUFPOS=1
      CALL FILNME(BUFFER,BUFPOS,PFILE)
 1001 IF (BUFPOS.GE.LEN) GOTO 1099
        IF (.NOT.EQUAL(BUFFER(BUFPOS),' ',1)) GOTO 1002
        BUFPOS=BUFPOS+1
        IF (BUFPOS.GT.80) GOTO 1006
      GOTO 1001
 1002 OPTPOS=1
      OPTN=1
 1003     IF (OPTN.GT.7) GOTO 1004
          FLAG=EQUALB(BUFFER,BUFPOS,OPTS,OPTPOS,OPTLEN(OPTN))
          OPTPOS=OPTPOS+OPTLEN(OPTN)
          OPTN=OPTN+1
          IF (.NOT.FLAG) GOTO 1003
        BUFPOS=BUFPOS+OPTLEN(OPTN-1)
        IF (BUFPOS.GT.80) GOTO 1006
        IF (OPTN.EQ.2) NMI=NUMBER(10,BUFFER,BUFPOS)
        IF (OPTN.EQ.3) INT=NUMBER(10,BUFFER,BUFPOS)
        IF (OPTN.EQ.4) CALL FILNME(BUFFER,BUFPOS,OPFILE)
        IF (OPTN.EQ.5) CALL FILNME(BUFFER,BUFPOS,IPFILE)
        IF (OPTN.NE.6) GOTO 90004
          PC=NUMBER(16,BUFFER,BUFPOS)
          EXFLAG=.TRUE.
90004 CONTINUE
        IF (OPTN.NE.7) GOTO 90007
          CALL SETINF(6,-100,80,'FC','PRIV.')
          CALL FILNME(BUFFER,BUFPOS,SCRFLE)
          CALL OPNFIL(8,RET,SCRFLE,'OKNEW OKOLD WROK.')
          CALL FILMSG(RET,6)
90007 CONTINUE
        IF (OPTN.EQ.8) DEBUG=.TRUE.
      GOTO 1001
 1004 WRITE (6,1005)
 1005 FORMAT(/' *Error : Unknown options on command line')
      CALL EOJ(81)
 1006 WRITE (6,1007)
 1007 FORMAT(/' *Error : Command line too long')
      CALL EOJ(82)
 1099 CONTINUE
C
C ######################################################################
C
C     Read machine code program into memory at appropriate location

      CALL OPNFIL(10,RC,PFILE,'OKOLD RDOK.')
      IF (RC.NE.30) GOTO 90010
        WRITE(6,2000)PFILE
 2000   FORMAT(/' *Error : File not found ',22A1)
        CALL EOJ(30)
90010 CONTINUE
      CALL FILMSG(RC,10)
 2001 READ(10,2101,END=2012) BUFFER
 2101 FORMAT(1X,104A1)
        IF (EQUAL(BUFFER,'1',1)) CALL LMOVE(' ',BUFFER,1)
        CALL LJUST(BUFFER,104,LEN,' ')
        IF (EQUAL(BUFFER(1),'#',1).AND..NOT.EQUAL(BUFFER(2),'R',1)
     +  .AND.RC.EQ.0) GOTO 90012
      GO TO 90013
90012 CONTINUE
          CALL VERALL(BUFFER,104,'0123456789ABCDEF ',17,POS,NUMPOS)
          IF (NUMPOS.EQ.2.AND.EQUAL(BUFFER(POS(2)),'&',1)) GOTO 90015
      GO TO 90016
90015 CONTINUE
            END=(POS(2)-POS(1)-5)/2
            READ(99,2002) PTR,(INPUT(I),I=1,END)
 2002       FORMAT(2X,Z4,48Z2)
            CALL CORE(BUFFER(POS(2)),4)
            READ (20,2003) CKSUM
 2003       FORMAT(1X,Z2)
            CKSUM=CKSUM-LAND(PTR,255)
            CKSUM=CKSUM-PTR/256
            DO 2004 I=1,END
              CALL WRMEM(PTR+I-1,BYTE(INPUT(I)))
              CKSUM=CKSUM-BYTE(INPUT(I))
              IF (PTR+I-1.EQ.65532.OR.PTR+I-1.EQ.65533)
     +                GOTMEM(PTR+I-65532)=.TRUE.
 2004       CONTINUE
            IF (ORGFLG) GOTO 90020
              ORG=PTR
              ORGFLG=.TRUE.
90020 CONTINUE
      GO TO 90017
90016 CONTINUE
            BADFRM=.TRUE.
90017 CONTINUE
      GO TO 90014
90013 CONTINUE
      IF        (EQUAL(BUFFER(2),'R',1).AND.RC.EQ.0) GOTO 90022
      GO TO 90023
90022 CONTINUE
          WRITE(6,2005)
 2005     FORMAT(/' *Error : Code requiring relocation not usable')
          CALL EOJ(84)
      GO TO 90014
90023 CONTINUE
      IF (EQUAL(BUFFER(1),'%',1).AND.RC.EQ.0) GOTO 90024
      GO TO 90025
90024 CONTINUE
          CALL LMOVE(' ',BUFFER,1)
          CALL LJUST(BUFFER,104,LEN,' ')
          CALL FNDALL(BUFFER,104,' =',2,POS,NUMPOS)
          LENGTH=POS(1)-1
          DO 2007 I=1,DESCS
            IF (EQUAL(BUFFER,DESC(I,1),LENGTH)) GOTO 90027
      GO TO 90028
90027 CONTINUE
              CALL LJUST(BUFFER(LENGTH),105-LENGTH,LEN,' ')
              IF (.NOT.EQUAL(BUFFER(LENGTH+1),'=',1)) GOTO 90030
      GO TO 90031
90030 CONTINUE
                WRITE(6,2006)
 2006           FORMAT(/' *Error : missing = in system descriptor')
                CALL EOJ(88)
90032 CONTINUE
90031 CONTINUE
              CALL LJUST(BUFFER(LENGTH+2),103-LENGTH,LEN,' ')
              IF (I.NE.3) GOTO 90033
      GO TO 90034
90033 CONTINUE
                TRAP(I)=NUMBER(16,BUFFER,LENGTH+2)
      GO TO 90035
90034 CONTINUE
                IF (EQUAL(BUFFER(LENGTH+2),'STANDARD',LEN)) GOTO 90036
      GO TO 90037
90036 CONTINUE
                  EXTEND=.FALSE.
      GO TO 90038
90037 CONTINUE
      IF             (EQUAL(BUFFER(LENGTH+2),'EXTENDED',LEN)) GOTO 90039
      GO TO 90040
90039 CONTINUE
                  EXTEND=.TRUE.
      GO TO 90038
90040 CONTINUE
                  TEMP=LENGTH+2
                  WRITE (6,2008) (BUFFER(I),I=1,TEMP)
90038 CONTINUE
90035 CONTINUE
              FOUND=.TRUE.
90029 CONTINUE
90028 CONTINUE
 2007     CONTINUE
          IF (FOUND) GOTO 90042
            WRITE(6,2008) (BUFFER(I),I=1,LENGTH)
 2008       FORMAT(/' *Error : urecognised system descriptor %',28A1)
            CALL EOJ(89)
90043 CONTINUE
90042 CONTINUE
      GO TO 90014
90025 CONTINUE
      IF        (RC.NE.0) GOTO 90045
          BADFRM=.TRUE.
      GO TO 90014
90045 CONTINUE
      IF        (RC.EQ.1) GOTO 90047
          CALL FILMSG(10,RC)
          CALL EOJ(RC)
90014 CONTINUE
90047 CONTINUE
        IF (.NOT.BADFRM) GOTO 90049
          WRITE(6,2009)
 2009     FORMAT(/' *Error : Assembly program format incorrect')
          CALL EOJ(83)
      GO TO 90050
90049 CONTINUE
      IF        (LAND(CKSUM,255).EQ.0) GOTO 90052
          TEMP=LAND(CKSUM,255)
          WRITE(6,2010) TEMP
 2010     FORMAT(/' *Error : Assembly program checksum error : ',Z2)
          CALL EOJ(83)
90050 CONTINUE
90052 CONTINUE
      IF (.NOT.EQUAL(BUFFER(1),'$',1).AND.RC.EQ.0) GOTO 2001
 2012 CALL CLSFIL(10,RC)
      IF (EXFLAG) GOTO 90054
        IF (GOTMEM(1).AND.GOTMEM(2)) GOTO 90057
          PC=ORG
      GO TO 90058
90057 CONTINUE
          PC=RDMEM(65532)+RDMEM(65533)*256
90058 CONTINUE
90054 CONTINUE
      WRITE(6,2011)PFILE,PC
C     WRITE(8,2011)PFILE,PC
2011  FORMAT(/' Program file : ',22A1/
     *   ' Starting execution at ',Z4,' hex'/)
      CALL Y6502(PC,DEBUG,EXTEND)
      CALL EOJ(0)
C
C     Clear screen and print header
C
      IF (DEBUG) GOTO 90059
      GO TO 90060
90059 CONTINUE
        WRITE(6,3001)
        WRITE(8,3001)
 3001   FORMAT('1 PC   Instruction   Assembly',T37,
     $               'Addr  Data    A   X   Y   SP    N V B D I Z C'/)
90061 CONTINUE
90060 CONTINUE
      STOP
      END
C
C
C ######################################################################
C
C                Subroutines and functions
C
C     Report execution of an invalid opcode
C
      SUBROUTINE INVOPC(ADDR)
      IMPLICIT INTEGER (A-Z,$)
      TEMP=RDMEM(ADDR)
      WRITE (6,1) TEMP,ADDR
 1    FORMAT(' * Unrecognised opcode ',Z2,' at address ',Z4,' *')
      RETURN
      END
C
C     List Debug information on the screen
C
      SUBROUTINE DBGLST(OPADDR,MODE,ADDR,DATA,REGS)
      IMPLICIT INTEGER (A-Z,$)
      INTEGER REGS(6),FLAGS(7)
      LOGICAL EQUAL
      LOGICAL*1 OPCSTR(3), OPDSTR(9),ADDSTR(8),DATSTR(8)
      INTEGER*4 OPCODS(128) /
     +  'BRK ', 'ORA ', '??? ', '??? ', 'TSB ', 'ORA ', 'ASL ', 'RMB ',
     +  'PHP ', 'ORA ', 'ASL ', '??? ', 'TSB ', 'ORA ', 'ASL ', 'BBR ',
     +  'BPL ', 'ORA ', 'ORA ', '??? ', 'TRB ', 'ORA ', 'ASL ', 'RMB ',
     +  'CLC ', 'ORA ', 'INA ', '??? ', 'TRB ', 'ORA ', 'ASL ', 'BBR ',
     +  'JSR ', 'AND ', '??? ', '??? ', 'BIT ', 'AND ', 'ROL ', 'RMB ',
     +  'PLP ', 'AND ', 'ROL ', '??? ', 'BIT ', 'AND ', 'ROL ', 'BBR ',
     +  'BMI ', 'AND ', 'AND ', '??? ', 'BIT ', 'AND ', 'ROL ', 'RMB ',
     +  'SEC ', 'AND ', 'DEA ', '??? ', 'BIT ', 'AND ', 'ROL ', 'BBR ',
     +  'RTI ', 'EOR ', '??? ', '??? ', '??? ', 'EOR ', 'LSR ', 'RMB ',
     +  'PHA ', 'EOR ', 'LSR ', '??? ', 'JMP ', 'EOR ', 'LSR ', 'BBR ',
     +  'BVC ', 'EOR ', 'EOR ', '??? ', '??? ', 'EOR ', 'LSR ', 'RMB ',
     +  'CLI ', 'EOR ', 'PHY ', '??? ', '??? ', 'EOR ', 'LSR ', 'BBR ',
     +  'RTS ', 'ADC ', '??? ', '??? ', 'STZ ', 'ADC ', 'ROR ', 'RMB ',
     +  'PLA ', 'ADC ', 'ROR ', '??? ', 'JMP ', 'ADC ', 'ROR ', 'BBR ',
     +  'BVS ', 'ADC ', 'ADC ', '??? ', 'STZ ', 'ADC ', 'ROR ', 'RMB ',
     +  'SEI ', 'ADC ', 'PLY ', '??? ', 'JMP ', 'ADC ', 'ROR ', 'BBR ' /
      INTEGER*4 DUMMY(128) /
     +  'BRA ', 'STA ', '??? ', '??? ', 'STY ', 'STA ', 'STX ', 'SMB ',
     +  'DEY ', 'BIT ', 'TXA ', '??? ', 'STY ', 'STA ', 'STX ', 'BBS ',
     +  'BCC ', 'STA ', 'STA ', '??? ', 'STY ', 'STA ', 'STX ', 'SMB ',
     +  'TYA ', 'STA ', 'TXS ', '??? ', 'STZ ', 'STA ', 'STZ ', 'BBS ',
     +  'LDY ', 'LDA ', 'LDX ', '??? ', 'LDY ', 'LDA ', 'LDX ', 'SMB ',
     +  'TAY ', 'LDA ', 'TAX ', '??? ', 'LDY ', 'LDA ', 'LDX ', 'BBS ',
     +  'BCS ', 'LDA ', 'LDA ', '??? ', 'LDY ', 'LDA ', 'LDX ', 'SMB ',
     +  'CLV ', 'LDA ', 'TSX ', '??? ', 'LDY ', 'LDA ', 'LDX ', 'BBS ',
     +  'CPY ', 'CMP ', '??? ', '??? ', 'CPY ', 'CMP ', 'DEC ', 'SMB ',
     +  'INY ', 'CMP ', 'DEX ', '??? ', 'CPY ', 'CMP ', 'DEC ', 'BBS ',
     +  'BNE ', 'CMP ', 'CMP ', '??? ', '??? ', 'CMP ', 'DEC ', 'SMB ',
     +  'CLD ', 'CMP ', 'PHX ', '??? ', '??? ', 'CMP ', 'DEC ', 'BBS ',
     +  'CPX ', 'SBC ', '??? ', '??? ', 'CPX ', 'SBC ', 'INC ', 'SMB ',
     +  'INX ', 'SBC ', 'NOP ', '??? ', 'CPX ', 'SBC ', 'INC ', 'SMB ',
     +  'BEQ ', 'SBC ', 'SBC ', '??? ', '??? ', 'SBC ', 'INC ', 'SMB ',
     +  'SED ', 'SBC ', 'PLX ', '??? ', '??? ', 'SBC ', 'INC ', 'SMB' /
      EQUIVALENCE (OPCODS(129),DUMMY(1))
C
      OPCODE=RDMEM(OPADDR)
      CALL LMOVE(OPCODS(OPCODE+1),OPCSTR,3)
      BYTES=1
      CALL FILL(OPDSTR,9,' ')
      IF (MODE.NE.13) CALL GTOPND(OPADDR,MODE,BYTES,OPDSTR)
      I=7
 3100 CONTINUE
        IF (I.GE.5) GOTO 90001
      GO TO 90002
90001 CONTINUE
          J=7-I
      GO TO 90003
90002 CONTINUE
          J=6-I
90003 CONTINUE
        FLAGS(J+1)=LAND(REGS(4),2**I)/2**I
        I = I - 1
      IF (I.GT.-1) GOTO 3100
 3101 CONTINUE
C
      IF (MODE.NE.13.AND..NOT.EQUAL(OPDSTR,'A',1).AND.OPCODE.NE.0)
     +   GOTO 90004
      GO TO 90005
90004 CONTINUE
        CALL I2X(ADDR,ADDSTR)
        IF (MODE.NE.8) GOTO 90007
      GO TO 90008
90007 CONTINUE
          CALL I2X(DATA,DATSTR)
      GO TO 90009
90008 CONTINUE
          CALL FILL(DATSTR,8,' ')
90009 CONTINUE
      GO TO 90006
90005 CONTINUE
        CALL FILL(ADDSTR,8,' ')
        CALL FILL(DATSTR,8,' ')
90006 CONTINUE
C
      GOTO (3102,3103,3104),BYTES
C
 3102   WRITE(6,3106)OPADDR,OPCODE,OPCSTR,OPDSTR,
     *       ADDSTR(5),ADDSTR(6),ADDSTR(7),ADDSTR(8),
     *       DATSTR(7),DATSTR(8),REGS(1),REGS(2),REGS(3),REGS(6),FLAGS
C       WRITE(8,3106)OPADDR,OPCODE,OPCSTR,OPDSTR,
C    *       ADDSTR(5),ADDSTR(6),ADDSTR(7),ADDSTR(8),
C    *       DATSTR(7),DATSTR(8),REGS(1),REGS(2),REGS(3),REGS(6),FLAGS
      RETURN
 3103   TEMP1 = RDMEM(OPADDR+1)
        WRITE(6,3107)OPADDR,OPCODE,TEMP1,OPCSTR,OPDSTR,
     *       ADDSTR(5),ADDSTR(6),ADDSTR(7),ADDSTR(8),
     *       DATSTR(7),DATSTR(8),REGS(1),REGS(2),REGS(3),REGS(6),FLAGS
C       WRITE(8,3107)OPADDR,TEMP1,TEMP2,OPCSTR,OPDSTR,
C    *       ADDSTR(5),ADDSTR(6),ADDSTR(7),ADDSTR(8),
C    *       DATSTR(7),DATSTR(8),REGS(1),REGS(2),REGS(3),REGS(6),FLAGS
      RETURN
 3104   TEMP1=RDMEM(OPADDR+1)
        TEMP2=RDMEM(OPADDR+2)
        WRITE(6,3108)OPADDR,OPCODE,TEMP1,TEMP2,OPCSTR,OPDSTR,
     *       ADDSTR(5),ADDSTR(6),ADDSTR(7),ADDSTR(8),
     *       DATSTR(7),DATSTR(8),REGS(1),REGS(2),REGS(3),REGS(6),FLAGS
C       WRITE(8,3108)OPADDR,TEMP1,TEMP2,TEMP3,OPCSTR,OPDSTR,
C    *       ADDSTR(5),ADDSTR(6),ADDSTR(7),ADDSTR(8),
C    *       DATSTR(7),DATSTR(8),REGS(1),REGS(2),REGS(3),REGS(6),FLAGS
      RETURN
 3106   FORMAT(1X,Z4,1(2X,Z2),11X,3A1,1X,9A1,3X,4A1,2X,2A1,1X,1X,3X,
     *           3(Z2,2X),'1',Z2,4X,7(I1,1X))
 3107   FORMAT(1X,Z4,2(2X,Z2),07X,3A1,1X,9A1,3X,4A1,2X,2A1,1X,1X,3X,
     *           3(Z2,2X),'1',Z2,4X,7(I1,1X))
 3108   FORMAT(1X,Z4,3(2X,Z2),03X,3A1,1X,9A1,3X,4A1,2X,2A1,1X,1X,3X,
     *           3(Z2,2X),'1',Z2,4X,7(I1,1X))
      END
C
C     Take appropriate action when the user interrupts the program
C
      SUBROUTINE USRATN(REG)
      IMPLICIT INTEGER (A-Z,$)
      INTEGER REG(6), DBGFLG /Z80000000/
      LOGICAL EQUAL
      LOGICAL*1 BUFFER(80)
      CALL PSTCOD(BUFFER)
 3300 WRITE(6,3301)
 3301 FORMAT(/' Press return to continue, S for storage dump,'/
     *        ' D to toggle debug, R to reset or Q to finish.'/)
      READ (9,3302)(BUFFER(I),I=1,80)
 3302 FORMAT(80A1)
      CALL LJUST(BUFFER,80,LEN,' ')
      IF (EQUAL(BUFFER,'Q ',2)) CALL EOJ(0)
      IF (EQUAL(BUFFER,'  ',2)) RETURN
      IF (EQUAL(BUFFER,'D ',2)) GOTO 90000
      GO TO 90001
90000 CONTINUE
        REG(4)=LXOR(REG(4),DBGFLG)
      GO TO 90002
90001 CONTINUE
      IF      (EQUAL(BUFFER(1),'R ',2)) GOTO 90003
      GO TO 90004
90003 CONTINUE
        REG(5)=RDMEM(65532)+RDMEM(65533)*256
      GO TO 90002
90004 CONTINUE
      IF      (EQUAL(BUFFER(1),'S ',2)) GOTO 90005
      GO TO 90006
90005 CONTINUE
        BUFPOS=2
        CALL VERIFY(BUFFER(2),79,' ',1,NONSPC)
        IF (NONSPC.EQ.0) GOTO 90007
      GO TO 90008
90007 CONTINUE
          WRITE(6,3303)
 3303     FORMAT(' Enter start address for memory dump ( hex ) :'/)
          READ(9,3302)(BUFFER(I),I=1,80)
          BUFPOS=1
90009 CONTINUE
90008 CONTINUE
        PTR=NUMBER(16,BUFFER,BUFPOS)
        IF (PTR.GT.65535) GOTO 3308
        CALL VERIFY(BUFFER(BUFPOS),80-BUFPOS,' ',1,NONSPC)
        IF (NONSPC.EQ.0) GOTO 90010
      GO TO 90011
90010 CONTINUE
          WRITE(6,3304)
 3304     FORMAT(' Enter finish address ( hex ) :'/)
          READ(9,3302)(BUFFER(I),I=1,80)
          BUFPOS=1
90012 CONTINUE
90011 CONTINUE
        END=NUMBER(16,BUFFER,BUFPOS)
        IF (END.GT.65536.OR.PTR.GE.END) GOTO 3308
        WRITE(8,3305)PTR,END
 3305   FORMAT(/,' Memory dump ',Z4,' - ',Z4/)
 3306   PTR1=PTR
          PTR2=PTR+15
          IF (PTR2.GE.65535) PTR2=65535
C         WRITE(6,3307)PTR,(RDMEM(J),J=PTR1,PTR2)
C         WRITE(8,3307)PTR,(RDMEM(J),J=PTR1,PTR2)
 3307     FORMAT(1X,Z4,5X,4(4(1X,Z2),3X))
          PTR=PTR+16
        IF (PTR.LT.END+1) GOTO 3306
90002 CONTINUE
90006 CONTINUE
      GOTO 3300
 3308   WRITE(6,3309)
 3309   FORMAT(/' *Error : Address out of range')
      GOTO 3300
      END
C
C     Function to extract a decimal or hex number from the command line
C     options or a string read in from the keyboard
C
      FUNCTION NUMBER(BASE,BUFFER,BUFPOS)
      IMPLICIT INTEGER($)
      INTEGER NUMBER,BASE,BUFPOS,CHAR
      LOGICAL*1 EQUALB
      LOGICAL*1 BUFFER(104)
      NUMBER=0
      CHAR=0
1     IF (.NOT.EQUALB(BUFFER,BUFPOS,1,' ',1)) GOTO 2
        BUFPOS=BUFPOS+1
        IF (BUFPOS.GT.80) GOTO 3
      GOTO 1
2     CALL LBMOVE(BUFFER,BUFPOS,CHAR,4,1)
        BUFPOS=BUFPOS+1
        IF (CHAR.EQ.64.OR.CHAR.EQ.107) GOTO 3
        IF (CHAR.LT.193.OR.(CHAR.GT.198.AND.CHAR.LT.240).OR.CHAR.GT.249)
     *    GOTO 4
        IF (CHAR.LT.240.AND.BASE.EQ.10) GOTO 4
        NUMBER=NUMBER*BASE+LAND(CHAR,15)
        IF (CHAR.LE.198) NUMBER=NUMBER+9
      IF (BUFPOS.LE.80) GOTO 2
3     RETURN
4       WRITE(6,5)
5       FORMAT(/' *Error : Input contains illegal numerical characters')
        CALL EOJ(87)
      END
C
C     Subroutine to extract a filename from the command line options
C
      SUBROUTINE FILNME(BUFFER,I,FNAME)
      IMPLICIT INTEGER($)
      LOGICAL*1 BUFFER(104),FNAME(22),EQUAL
      CALL FILL(FNAME,22,' ')
1     IF (.NOT.EQUAL(BUFFER(I),' ',1)) GOTO 2
        I=I+1
        IF (I.GT.80) GOTO 4
      GOTO 1
2     J=1
3     FNAME(J)=BUFFER(I)
        I=I+1
        J=J+1
        IF (EQUAL(BUFFER(I),' ',1).OR.EQUAL(BUFFER(I),',',1)) GOTO 6
        IF (J.EQ.23) GOTO 4
      IF (I.LE.80) GOTO 3
4     WRITE(6,5)
5     FORMAT(/' *Error : Invalid filename')
      CALL EOJ(12)
6     I=I+1
      RETURN
      END
C
C     Subroutine to return the operand of an instruction in a printable
C     form suitable for display in the assembly language listing.
C     Also return the number of bytes in the instruction.
C
      SUBROUTINE GTOPND(OPADDR,MODE,BYTES,OPDSTR)
      IMPLICIT INTEGER (A-Z,$)
      LOGICAL*1 HEXSTR(8),OPDSTR(9)
      PC=LAND(OPADDR+1,65535)
      LOBYTE=RDMEM(PC)
      PC=LAND(PC+1,65535)
      HIBYTE=RDMEM(PC)
      CALL I2X(LOBYTE+HIBYTE*256,HEXSTR)
      TEMP=MODE+1
      GOTO (100,101,102,103,104,105,106,107,108,109,110,111,112),TEMP
C
C       (ind,x)
C
C 100   OPDSTR='(&'//HEXSTR(7:8)//',X)'
  100   CALL LMOVE('(&??,X)  ',OPDSTR,9)
        CALL LMOVE(HEXSTR(7),OPDSTR(3),2)
        BYTES=2
      RETURN
C
C       zp
C
C 101   OPDSTR='&'//HEXSTR(7:8)
  101   CALL LMOVE('&??      ',OPDSTR,9)
        CALL LMOVE(HEXSTR(7),OPDSTR(2),2)
        BYTES=2
      RETURN
C
C       # imm
C
C 102   OPDSTR='# &'//HEXSTR(7:8)
  102   CALL LMOVE('#&??     ',OPDSTR,9)
        CALL LMOVE(HEXSTR(7),OPDSTR(3),2)
        BYTES=2
      RETURN
C
C       abs
C
C 103   OPDSTR='&'//HEXSTR(5:8)
  103   CALL LMOVE('&????    ',OPDSTR,9)
        CALL LMOVE(HEXSTR(5),OPDSTR(2),4)
        BYTES=3
      RETURN
C
C       (ind),y
C
C 104   OPDSTR='(&'//HEXSTR(7:8)//'),Y'
  104   CALL LMOVE('(&??),Y  ',OPDSTR,9)
        CALL LMOVE(HEXSTR(7),OPDSTR(3),2)
        BYTES=2
      RETURN
C
C       zp,x
C
C 105   OPDSTR='&'//HEXSTR(7:8)//',X'
  105   CALL LMOVE('&??,X    ',OPDSTR,9)
        CALL LMOVE(HEXSTR(7),OPDSTR(2),2)
        BYTES=2
      RETURN
C
C       abs,y
C
C 106   OPDSTR='&'//HEXSTR(5:8)//',Y'
  106   CALL LMOVE('&????,Y  ',OPDSTR,9)
        CALL LMOVE(HEXSTR(5),OPDSTR(2),4)
        BYTES=3
      RETURN
C
C       abs,x
C
C 107   OPDSTR='&'//HEXSTR(5:8)//',X'
  107   CALL LMOVE('&????,X  ',OPDSTR,9)
        CALL LMOVE(HEXSTR(5),OPDSTR(2),4)
        BYTES=3
      RETURN
C
C       (abs)
C
C 108   OPDSTR='(&'//HEXSTR(5:8)//')'
  108   CALL LMOVE('(&????)  ',OPDSTR,9)
        CALL LMOVE(HEXSTR(5),OPDSTR(3),4)
        BYTES=3
      RETURN
C
C       rel
C
  109   OPAND=LOBYTE
        IF (LOBYTE.GE.128) LOBYTE=LOBYTE-256
        ADDR=LAND(PC+LOBYTE,65535)
        CALL I2X(ADDR,HEXSTR)
C       OPDSTR='&'//HEXSTR(5:8)
        CALL LMOVE('&????    ',OPDSTR,9)
        CALL LMOVE(HEXSTR(5),OPDSTR(2),4)
        BYTES=2
      RETURN
C
C       zp,y
C
C 110   OPDSTR='&'//HEXSTR(7:8)//',Y'
  110   CALL LMOVE('&??,Y    ',OPDSTR,9)
        CALL LMOVE(HEXSTR(7),OPDSTR(2),2)
        BYTES=2
      RETURN
C
C       (ind)
C
C 111   OPDSTR='(&'//HEXSTR(7:8)//')'
  111   CALL LMOVE('(&??)    ',OPDSTR,9)
        CALL LMOVE(HEXSTR(7),OPDSTR(3),2)
        BYTES=2
      RETURN
C
C       (abs,x)
C
C 112   OPDSTR='(&'//HEXSTR(5:8)//',X)'
  112   CALL LMOVE('(&????),X',OPDSTR,9)
        CALL LMOVE(HEXSTR(5),OPDSTR(3),4)
        BYTES=3
      RETURN
      END