!       B i n a r y  M a i n t a i n e n c e  P r o g r a m
!
!       v1.0    10/8/80
!       v1.0a   1/29/81 added <a>,<b>;C computes checksum over <a,b>
!                       ;H prints directory entry displacement
!                       ;L doesn't error on 32 byte record starting at FFE0
!                       <eof> consistently causes 0's to be displayed
!
!       v1.0b   2/19/81 Fixed <fid>;L loops forever if file has 0 bytes
!               Allow lower case text entry after "
!               Fixed "destroys object file if new load record added"
!
!       v1.0c   2/2/82 Changed UPPER, LOWER, and FILEPOS to accomodate
!               200 load records, rather than 50.
!       v1.0d   2/12/82 Modified to use single-character activation...
!               instead of READB$
!               Displays non-existent locations as XX
!       v1.0e   4/24/82 Allowed BMP to use READ BINARY if CC:SETACTIVATION
!               doesn't work.  Put in code to use BINARYACCESS.ASM as comments.
!       v1.0f   8/30/83 Allowed BMP to accept ;B and ;L commands for 6809 bins.
!
!
!       COMMANDS:
!
!       <E>/            SHOW CONTENTS OF LOCATION
!       <CR>            CLOSE CELL
!       <LF>            CLOSE CELL, OPEN AND DISPLAY NEXT
!       ^               CLOSE CELL, OPEN AND DISPLAY PREVIOUS
!       <N><CR>         DEPOSIT AND CLOSE CELL
!       <N><LF>         DEPOSIT AND DISPLAY NEXT
!       <N>^            DEPOSIT AND DISPLAY PREVIOUS
!
!       <E> := <E>+<E> / <E>-<E> / <E>*<E> / -<E> / <HEX> / . /
!               <E>&<E> / <E>!<E> / <E>#<E> / <DEC>\ / <BIN>% ;
!       <BIN>:= 0..1 / <BIN> ;
!       <DEC>:= 0..9 / <DEC> ;
!       <HEX>:= 0..9, A..F / <HEX> ;
!       <N> := $<E> / <OPCODE> / <OPCODE> <ARG> ;
!       <OPCODE>:= LDAA / LDAB / ADDA / ADDB / ... ;
!       <ARG> := #<E> / <E>,X / <E> ;
!
!       <FILENAME>;D    OPEN <FILENAME> FOR DISK DUMP
!       <FILENAME>;B    OPEN <FILENAME> FOR BINARY
!       <FILENAME>;H    FIND HEADER FOR <FILENAME>
!       <FILENAME>;L    SHOW LOAD RECORDS FOR <FILENAME>
!
!       ;A              ASCII DISPLAY MODE
!       <E>;C           SET IOBASE TO CLUSTER <E>
!       <E>;S           SET IOBASE TO SECTOR <E>
!       ;H              HEX DISPLAY MODE
!       ;X              DOUBLE HEX DISPLAY MODE
!       ;O              OP CODE DISPLAY MODE (DIS-ASSEMBLY)
!       ;M              MEMORY ACCESS MODE (DEFAULT)
!
!       <E>,<E>/        MEMORY DUMP
!       <E>=            EXPRESSION EVALUATION
!
!       <E>?T           SET SEARCH TARGET
!       <E>?M           SET SEARCH MASK (A LA IDB)
!       ?               DISPLAY SEARCH TARGET AND MASK
!       <E>,<E>?S       PERFORM SEARCH MODIFIED BY MASK

        DIM     FILENAME$[16], ENTRY$[16], READNONE$/:A,:E,0,0/, EMPTY$[0]
        DIM     SETER$/:13,4,0,0/, PRINTER$/:15,2/, DOT/0/, STARTADFLAG/0/
        DIM     HX$/"0123456789ABCDEF"/, TLINE$[7]
        DIM     UNLOCK$/:E,4,1,:10/, OPRFLAG/0/, PLUS/1/, MINUS/2/, NEGATE/3/
        DIM     SPACEFLAG/0/, READB$/:B,:E,1,0/
        DIM     READA$/:A,:E,0,1/,CCSETACTBLOCK$/:E,8,0,:14/
        DIM     SINGLECHARACTIVATION$/:00,:24,:00,:00,:FF,:FF,:FF,:FF,...
&                                     :FF,:FF,:FF,:FF,:FF,:FF,:FF,:FF/
! DON'T ACTIVATE ON: ^A,^B,^C,^D,^E,^G,^O,^P,^Q,^S,^T,^U,^V,^X,^Z,<ESC>
        DIM     NORMALACTIVATION$/:00,:00,:00,:00,:00,:00,:00,:00,...
&                                 :00,:00,:00,:00,:00,:00,:00,:00/
        DIM     TARGET$[40]/0/,MASK$[40]/:FF/
        DIM     STARTAD,FINISHAD
        DIM     TIMES/4/, BEFORESPACE$[10], IMEDIATE/0/, DOLARFLAG/0/
        DIM     EXCLUSIVEOR/5/, LOGICALAND/6/, LOGICALOR/7/
        DIM     IOBASE/0/, NBPS, NSPC, OPRVAL
        DIM     MAXAD, GETPARAMS$/:F,:E,2,:5/, PARAMS$[10]
        DIM     LOADREC$/0/,TWOBYTES$/0,0/
        DIM     COMMAAD/0/
        DIM     LOWER(200),UPPER(200),FILEPOS(200),TOP/0/,CURPOS
        DIM     SPACES$/"                 "/, LN2$/2/, LN3$/3/
        DIM     IOMODE/1/, MEMORY/1/, DISKDUMP/2/, BINARY/3/
        DIM     PPTEMP, PPDATA$/0/
        DIM     LFFLAG/0/, TEMP$[100], COMMAFLAG/0/
        DIM     CELLOPENFLAG/0/, PPADDRESS, PPDATA
        DIM     DISPMODE/1/, SINGLEHEX/1/, DOUBLEHEX/2/, DISASM/3/, ASCII/4/
        DIM     OP, BYTE, ADDRESS/0/
        DIM     I/-1/, J, K, MEMAD$[100]
        DIM     CHAR$[1], BS$/8/, CR$/13/, LF$/10/, RUBOUT$/:7F/
        DIM     LASTAD/-1/, ESC$/:1B/, X,OPNEXT/0/
        DIM     ACTIVATORS$/8,13,10,:1B,"/^*;,+-='. #&!$%\?"/
        DIM     SEMIACTIVATORS$/:1B,"$%\'"/
        DIM     OP$[8], LN$[1], LRCOUNT

        DIM     OPS$[1792]/ ...
&       0, '      ', 1, 'NOP   ', 0, '      ', 0, '      ', ...
&       0, '      ', 0, '      ', 1, 'TAP   ', 1, 'TPA   ', ...
&       1, 'INX   ', 1, 'DEX   ', 1, 'CLV   ', 1, 'SEV   ', ...
&       1, 'CLC   ', 1, 'SEC   ', 1, 'CLI   ', 1, 'SEI   ', ...
&       1, 'SBA   ', 1, 'CBA   ', 0, '      ', 0, '      ', ...
&       0, '      ', 0, '      ', 1, 'TAB   ', 1, 'TBA   ', ...
&       0, '      ', 1, 'DAA   ', 0, '      ', 1, 'ABA   ', ...
&       0, '      ', 0, '      ', 0, '      ', 0, '      ', ...
&       2, 'BRA   ', 0, '      ', 2, 'BHI   ', 2, 'BLS   ', ...
&       2, 'BCC   ', 2, 'BCS   ', 2, 'BNE   ', 2, 'BEQ   ', ...
&       2, 'BVC   ', 2, 'BVS   ', 2, 'BPL   ', 2, 'BMI   ', ...
&       2, 'BGE   ', 2, 'BLT   ', 2, 'BGT   ', 2, 'BLE   ', ...
&       1, 'TSX   ', 1, 'INS   ', 1, 'PULA  ', 1, 'PULB  ', ...
&       1, 'DES   ', 1, 'TXS   ', 1, 'PSHA  ', 1, 'PSHB  ', ...
&       0, '      ', 1, 'RTS   ', 0, '      ', 1, 'RTI   ', ...
&       0, '      ', 0, '      ', 1, 'WAI   ', 1, 'SWI   ', ...
&       1, 'NEGA  ', 0, '      ', 0, '      ', 1, 'COMA  ', ...
&       1, 'LSRA  ', 0, '      ', 1, 'RORA  ', 1, 'ASRA  ', ...
&       1, 'ASLA  ', 1, 'ROLA  ', 1, 'DECA  ', 0, '      ', ...
&       1, 'INCA  ', 1, 'TSTA  ', 0, '      ', 1, 'CLRA  ', ...
&       1, 'NEGB  ', 0, '      ', 0, '      ', 1, 'COMB  ', ...
&       1, 'LSRB  ', 0, '      ', 1, 'RORB  ', 1, 'ASRB  ', ...
&       1, 'ASLB  ', 1, 'ROLB  ', 1, 'DECB  ', 0, '      ', ...
&       1, 'INCB  ', 1, 'TSTB  ', 0, '      ', 1, 'CLRB  ', ...
&       2, 'NEGB X', 0, '      ', 0, '      ', 2, 'COM  X', ...
&       2, 'LSR  X', 0, '      ', 2, 'ROR  X', 2, 'ASR  X', ...
&       2, 'ASL  X', 2, 'ROL  X', 2, 'DEC  X', 0, '      ', ...
&       2, 'INC  X', 2, 'TST  X', 2, 'JMP  X', 2, 'CLR  X', ...
&       3, 'NEG   ', 0, '      ', 0, '      ', 3, 'COM   ', ...
&       3, 'LSR   ', 0, '      ', 3, 'ROR   ', 3, 'ASR   ', ...
&       3, 'ASL   ', 3, 'ROL   ', 3, 'DEC   ', 0, '      ', ...
&       3, 'INC   ', 3, 'TST   ', 3, 'JMP   ', 3, 'CLR   ', ...
&       2, 'SUBA #', 2, 'CMPA #', 2, 'SBCA #', 0, '      ', ...
&       2, 'ANDA #', 2, 'BITA #', 2, 'LDA  #', 0, '      ', ...
&       2, 'EORA #', 2, 'ADCA #', 2, 'ORAA #', 2, 'ADDA #', ...
&       3, 'CPX  #', 2, 'BSR   ', 3, 'LDS  #', 0, '      ', ...
&       2, 'SUBA  ', 2, 'CMPA  ', 2, 'SBCA  ', 0, '      ', ...
&       2, 'ANDA  ', 2, 'BITA  ', 2, 'LDA   ', 2, 'STA   ', ...
&       2, 'EORA  ', 2, 'ADCA  ', 2, 'ORAA  ', 2, 'ADDA  ', ...
&       2, 'CPX   ', 0, '      ', 2, 'LDS   ', 2, 'STS   ', ...
&       2, 'SUBA X', 2, 'CMPA X', 2, 'SBCA X', 0, '      ', ...
&       2, 'ANDA X', 2, 'BITA X', 2, 'LDA  X', 2, 'STA  X', ...
&       2, 'EORA X', 2, 'ADCA X', 2, 'ORAA X', 2, 'ADDA X', ...
&       2, 'CPX  X', 2, 'JSR  X', 2, 'LDS  X', 2, 'STS  X', ...
&       3, 'SUBA  ', 3, 'CMPA  ', 3, 'SBCA  ', 0, '      ', ...
&       3, 'ANDA  ', 3, 'BITA  ', 3, 'LDA   ', 3, 'STA   ', ...
&       3, 'EORA  ', 3, 'ADCA  ', 3, 'ORAA  ', 3, 'ADDA  ', ...
&       3, 'CPX   ', 3, 'JSR   ', 3, 'LDS   ', 3, 'STS   ', ...
&       2, 'SUBB #', 2, 'CMPB #', 2, 'SBCB #', 0, '      ', ...
&       2, 'ANDB #', 2, 'BITB #', 2, 'LDB  #', 0, '      ', ...
&       2, 'EORB #', 2, 'ADCB #', 2, 'ORAB #', 2, 'ADDB #', ...
&       0, '      ', 0, '      ', 3, 'LDX  #', 0, '      ', ...
&       2, 'SUBB  ', 2, 'CMPB  ', 2, 'SBCB  ', 0, '      ', ...
&       2, 'ANDB  ', 2, 'BITB  ', 2, 'LDB   ', 2, 'STB   ', ...
&       2, 'EORB  ', 2, 'ADCB  ', 2, 'ORAB  ', 2, 'ADDB  ', ...
&       0, '      ', 0, '      ', 2, 'LDX   ', 2, 'STX   ', ...
&       2, 'SUBB X', 2, 'CMPB X', 2, 'SBCB X', 0, '      ', ...
&       2, 'ANDB X', 2, 'BITB X', 2, 'LDB  X', 2, 'STB  X', ...
&       2, 'EORB X', 2, 'ADCB X', 2, 'ORAB X', 2, 'ADDB X', ...
&       0, '      ', 0, '      ', 2, 'LDX  X', 2, 'STX  X', ...
&       3, 'SUBB  ', 3, 'CMPB  ', 3, 'SBCB  ', 0, '      ', ...
&       3, 'ANDB  ', 3, 'BITB  ', 3, 'LDB   ', 3, 'STB   ', ...
&       3, 'EORB  ', 3, 'ADCB  ', 3, 'ORAB  ', 3, 'ADDB  ', ...
&       0, '      ', 0, '      ', 3, 'LDX   ', 3, 'STX   ' /

! ******** UTILITY SUBROUTINES *************
        DEF     LSB(X1)=INT(X1-256*INT(X1/256))
        DEF     MSB(X2)=INT(X2/256)

DEF KEYSTROKE$
    IF ERROR WHEN SYSCALL #0,CCSETACTBLOCK$,SINGLECHARACTIVATION$
    THEN SYSCALL #0,READB$,'',CHAR$\CHAR$(1)=CHAR$(1)&:7F
    ELSE SYSCALL #0,READA$,'',CHAR$
    RETURN CHAR$
END

! ********** END UTILITY SUBROUTINES ************

        PRINT "BMP V1.0f1   Copyright (C) 1983 Software Dynamics"
        PRINT

        ON      ERROR GOTO 400
10      MEMAD$  =""
        LFFLAG  =FALSE
        GOSUB POP 0

20      CHAR$=KEYSTROKE$
        LET CHAR$=UPPERCASE$(CHAR$)
        IF      CHAR$=RUBOUT$ THEN 25
        IF      FIND(ACTIVATORS$,CHAR$) THEN 30
        MEMAD$  =MEMAD$ CAT CHAR$
        GOTO    20
25      IF      MEMAD$="" THEN 20
        PRINT BS$;" ";BS$;
        MEMAD$  =MEMAD$(1,LEN(MEMAD$)-1)
        GOTO    20


30      IF OPRFLAG<>0 AND NOT(FIND(SEMIACTIVATORS$,CHAR$))
        THEN    GOSUB 1900
        IF      CHAR$="'" THEN 2100
        IF      CHAR$="/" THEN 300
        IF      CHAR$=CR$ THEN 100
        IF      CHAR$=LF$ THEN 200
        IF      CHAR$="^" THEN 500
        IF      CHAR$=";" THEN 800
        IF      CHAR$="," THEN 1300
        IF      CHAR$="+" THEN 1800
        IF      CHAR$="-" THEN 1810
        IF      CHAR$="=" THEN 2000
        IF      CHAR$="*" THEN 1820
        IF      CHAR$=" " THEN 2300
        IF      CHAR$="#" THEN 2400
        IF      CHAR$="!" THEN 1850
        IF      CHAR$="&" THEN 1830
        IF      CHAR$="$" THEN 2500
        IF      CHAR$="%" THEN 3000 \ ! CONVERT BINARY NUMBER
        IF      CHAR$="\" THEN 3010 \ ! CONVERT DECIMAL NUMBER
        IF      CHAR$=ESC$ THEN 3020
        IF      CHAR$="?" THEN 4000
        IF      CHAR$<>"." THEN 2200

        IF      MEMAD$<>"" THEN MEMAD$=MEMAD$ CAT "."\
                                GOTO 20 \
                                ! DOT MUST BE ON EMPTY LINE TO BE COMMAND

        MEMAD$  =HEX$(DOT)
        MEMAD$  =MEMAD$[2,4]
        GOTO    20

100     PRINT
        GOSUB   2600 \! CHECK FUNNY CONDITIONS
        IF MEMAD$=""
        THEN    IF SPACEFLAG
                THEN    PRINT "' '<CR> is a rather meaningless combination!" FI\
                GOSUB 2702 \
                I = -1 \
                GOTO 10
        IF STARTADFLAG=TRUE THEN 3040
        IF CELLOPENFLAG=FALSE
        THEN    PRINT "I don't know where to deposit that!" \
                GOSUB 2702 \
                GOTO 10
        ADDRESS =LASTAD
        GOSUB   600
        GOSUB 2702
        GOTO    10

200     PRINT
        GOSUB   2600
        IF      CELLOPENFLAG=FALSE
        THEN    PRINT "I don't know where to deposit that!" \
                GOSUB 2702 \
                GOTO 10
        IF      MEMAD$="" THEN 210
        ADDRESS =LASTAD
        GOSUB   600
!       DO THE DEPOSIT
210     ADDRESS =OPNEXT
        DOT     =ADDRESS
        GOSUB   700
        CELLOPENFLAG=TRUE
        GOTO    10


300     IF      COMMAFLAG THEN 310
        IF MEMAD$="START" THEN 3030
        IF MEMAD$[1]=ASC("$") THEN MEMAD$=RIGHT$(MEMAD$,2)
        GOSUB   2700
        LASTAD  =VAL(":" CAT MEMAD$)
        I       =LASTAD
        ADDRESS =I
        DOT     =ADDRESS
        CELLOPENFLAG=TRUE
        GOSUB   701
        GOTO    10

310     IF MEMAD$[1]=ASC("$") THEN MEMAD$=RIGHT$(MEMAD$,2)
        GOSUB   2700
        MAXAD   =VAL(":" CAT MEMAD$)
        COMMAFLAG=FALSE
        IF      MAXAD<256 AND LEN(MEMAD$)<3 THEN MAXAD=MAXAD+COMMAAD-1
        DOT     =COMMAAD
        IF      DISPMODE=DISASM THEN 350


        PRINT \ IF COMMAAD&:F<>0 THEN MEMAD$=HEX$(COMMAAD) \
                        PRINT MEMAD$[2,4];"/";
        MEMAD$=""

        FOR     PPADDRESS=COMMAAD TO MAXAD STEP 1
           GOSUB   1000 \!  GET BYTE
           IF      PPADDRESS&:F=0 THEN TEMP$=HEX$(PPADDRESS) \
                   PRINT TEMP$[2,4];"/";
           IF LOCATIONFOUND
           THEN TEMP$=HEX$(PPDATA)[4,2] ELSE TEMP$="xx"
           PRINT   TEMP$;" ";
           IF      PPDATA&:7F>:1F AND PPDATA&:7F<>:7F
                   THEN TEMP$[1]=PPDATA&:7F \ MEMAD$=MEMAD$ CAT TEMP$[1,1]
                   ELSE MEMAD$=MEMAD$ CAT "."
           IF      PPADDRESS&:F =:F THEN PRINT TAB(60);MEMAD$ \
                   MEMAD$=""
        NEXT    PPADDRESS
        PRINT   TAB(60);MEMAD$
        GOTO    10

350     ADDRESS =COMMAAD
        PRINT
        GOSUB   700

351     ADDRESS =OPNEXT
        IF      ADDRESS>MAXAD THEN 352
        PRINT \ GOSUB 700
        GOTO    351

352     PRINT \ CELLOPENFLAG=FALSE
        GOTO    10


400     SETER$[3]=MSB(ERR)
        SETER$[4]=LSB(ERR)
        CALL SYSCALL(SETER$)
        PRINT
        CALL SYSCALL(PRINTER$)
        PRINT " at line";ELN
        GOSUB   2702
        GOTO    10
500     PRINT
        GOSUB   2600
        IF      MEMAD$="" THEN 510
        ADDRESS =LASTAD
        GOSUB   600
510     ADDRESS =ADDRESS-1
        GOSUB   700
        LASTAD  =ADDRESS
        CELLOPENFLAG=TRUE
        GOTO    10
699     IF LEN(TEMP$)<>0 AND TEMP$[1]=ASC(' ') THEN TEMP$=RIGHT$(TEMP$,2) \
                GOTO 699
        IF      TEMP$="" THEN TEMP$="FF"
        RETURN


!
!       DEPOSIT INTO ADDRESS
!
600     IF DOLARFLAG AND NOT(SPACEFLAG) THEN 605
!       IF THIS THING JUST CAN'T BE AN OP CODE...
        IF NOT(SPACEFLAG) AND LEN(MEMAD$)>4 THEN 601
        DOLARFLAG=FALSE
        I       =ADDRESS
        LASTAD  =ADDRESS

!       SYMBOLIC ENTRY:
!       BREAK LINE INTO TWO HALVES
!
        IF      SPACEFLAG
        THEN    TEMP$=BEFORESPACE$
        ELSE    TEMP$=MEMAD$ \ MEMAD$=""
        GOSUB   699
!       REMOVE SPACES
        IF      LEN(TEMP$)<>6 THEN TEMP$ =TEMP$ CAT SPACES$[1,6-LEN(TEMP$)]
        IF      IMEDIATE THEN TEMP$[6]=ASC('#')
        IMEDIATE=FALSE
        IF      FIND(MEMAD$,",X") THEN TEMP$[6]=ASC('X')
        OP$     =TEMP$
        TEMP$   =MEMAD$
        IF      TEMP$<>"" THEN GOSUB 699
        IF      LEN(TEMP$)>1 AND TEMP$[1]=ASC('#') THEN TEMP$=RIGHT$(TEMP$,2)
        IF      TEMP$<>"" THEN GOSUB 1400 ELSE BYTE = 65536 
        IF      BYTE<256 AND OP$[6]=ASC(' ') AND SPACEFLAG
                THEN OP$=LN2$ CAT OP$
        IF      BYTE>255 AND SPACEFLAG THEN OP$=LN3$ CAT OP$
        X       =FIND(OPS$,OP$)
        IF      X=0 AND LEN(OP$)=7
                THEN IF OP$[1,1]=LN2$
                        THEN OP$=LN3$ CAT RIGHT$(OP$,2) 
                        ELSE OP$=LN2$ CAT RIGHT$(OP$,2) FI \
                X=FIND(OPS$,OP$) 
        IF X=0 AND SPACEFLAG=FALSE
        THEN    MEMAD$=OP$ \
                FOR I=1 TO 4 \
                        IF MEMAD$[I]<>ASC(' ') THEN LEN(MEMAD$)=I FI \
                NEXT I \
                GOTO 601
        IF X=0
        THEN    PRINT "Opcode not found" \
                GOSUB 2702 \
                GOTO 10
!       TRANSLATE INTO REAL OPCODE
        X       =INT((X-1)/7)
        LN$     =OPS$[X*7+1,1]

!       CHECK VALIDITY OF OP CODE...
        IF LN$[1]<>1 AND BYTE=65536
        THEN    PRINT "That op code requires an argument" \
                GOSUB 2702 \
                GOTO 10
!       PLANT OP CODE
        PPADDRESS=I \ PPDATA=X \ GOSUB 1100
        I       =I+1

        IF      LN$[1]=3
                THEN PPDATA=INT(BYTE/256) \ PPADDRESS=I \ GOSUB 1100 \
                I = I+1 \
                PPADDRESS=I \ PPDATA=INT(BYTE-256*INT(BYTE/256)) \ GOSUB 1100\
                GOTO 609

        IF      LN$[1]=1 THEN 610
        IF      X&:F0<>:20 AND X<>:8D
                THEN PPADDRESS=I \ PPDATA=BYTE \ GOSUB 1100 \ GOTO 609

        IF      I-BYTE>127 OR BYTE-I>128
                THEN    PRINT "BRA/BSR out of range" \
                PPADDRESS=I \ PPDATA=:FE \ GOSUB 1100 \ GOTO 609

        IF      I>=BYTE THEN PPADDRESS=I \ PPDATA =:FF-(I-BYTE) \
                GOSUB 1100
                ELSE PPDATA=BYTE-(I+1) \ PPADDRESS=I \ GOSUB 1100
        GOTO    609
601     ! THIS THING TYPED IN SHOULD HAVE BEEN AN OPCODE, BUT
!         I CAN'T MAKE HEADS NOT TAILS OUT OF IT... MAYBE IT'S A HEX NUMBER
        FOR     I=1 TO LEN(MEMAD$)
                IF NOT(FIND(HX$,MEMAD$[I,1]))
                THEN    GOSUB 2702 \
                        PRINT "That's neither an op code nor a hex number!"\
                        GOTO 10
        NEXT    I
605     GOSUB   2700
        I       =ADDRESS
        LASTAD  =ADDRESS
606     IF LEN(MEMAD$)>2
        THEN    IF LEN(MEMAD$)&1
                THEN    PPDATA=INT(VAL(":" CAT LEFT$(MEMAD$,1))) \
                        MEMAD$=RIGHT$(MEMAD$,2)
                ELSE    PPDATA=INT(VAL(":" CAT LEFT$(MEMAD$,2))) \
                        MEMAD$=RIGHT$(MEMAD$,3) FI \
                PPADDRESS=I \ GOSUB 1100 \
                I = I+1 \ GOTO 606
        PPDATA=INT(VAL(":" CAT MEMAD$))
        PPADDRESS=I \ GOSUB 1100
609     I       =I+1
610     OPNEXT  =I
        GOTO    2702


!
!       DISPLAY ADDRESS
!
700     MEMAD$  =HEX$(ADDRESS)
        PRINT   MEMAD$[2,4];"/";
701     I       =ADDRESS
        LASTAD  =ADDRESS
        IF      DISPMODE=SINGLEHEX THEN 710
        IF      DISPMODE=DOUBLEHEX THEN 720
        IF      DISPMODE=ASCII THEN 730
        PPADDRESS       =I
        GOSUB   1000
        OP      =PPDATA
        LN$     =OPS$[OP*7+1,1]
        OP$     =OPS$[OP*7+2,6]

        IF      LN$[1]=0
        THEN
            IF LOCATIONFOUND
            THEN OP$=HEX$(OP)[4,2] ELSE OP$="xx"
            OP$="FCB   " CAT OP$
            LN$[1]=1
        FI
        LN$[1]  =LN$[1]-1

        BYTE    =0
        IF      LN$[1]=2 THEN PPADDRESS=I+1 \ GOSUB 1000 \ BYTE=PPDATA**8 \
                        PPADDRESS=I+2 \ GOSUB 1000 \ BYTE=BYTE+PPDATA
        IF      LN$[1]=1 THEN PPADDRESS=I+1 \ GOSUB 1000 \ BYTE=PPDATA

        TEMP$   =HEX$(OP)
        PRINT   TEMP$[4,2];" ";
        TEMP$   =HEX$(BYTE)

        I       =LN$[1]+I
        IF      LN$[1]=2 THEN PRINT TEMP$[2,4]; ELSE ...
&       IF      LN$[1]=1 THEN PRINT TEMP$[4,2];"  "; ELSE PRINT "    ";
        IF      OP$[6]=ASC('X')
                THEN PRINT "  ";OP$[1,5];" ";
                ELSE PRINT "  ";OP$;
        IF      OP&:F0 =:20 OR OP=:8D AND OP<>:21
        THEN
                IF BYTE>=:80
                THEN BYTE=I+BYTE-:FF
                ELSE BYTE=I+BYTE+1 FI \
                IF BYTE<0 THEN BYTE=BYTE+65536
                IF BYTE>=65536 THEN BYTE=BYTE-65536
                TEMP$=HEX$(BYTE) \ LN$[1]=2
        FI
        IF      LN$[1]=1 THEN PRINT TEMP$[4,2]; \
                IF OP$[6]=ASC('X')
                        THEN PRINT ",X";
        IF      LN$[1]=2 THEN PRINT TEMP$[2,4];
        PRINT   "   ";
        OPNEXT  =I+1
        RETURN

710     ! DISPLAY SINGLE BYTE HEX
        PPADDRESS=ADDRESS\GOSUB GETHEXDISPLAYBYTE
        PRINT   MEMAD$;"  ";
        OPNEXT  =ADDRESS+1
        RETURN

720     ! DISPLAY DOUBLE BYTE HEX
        PPADDRESS=ADDRESS \ GOSUB GETHEXDISPLAYBYTE
        PRINT MEMAD$;
        PPADDRESS=ADDRESS+1 \ GOSUB GETHEXDISPLAYBYTE
        PRINT   MEMAD$;"  ";
        OPNEXT  =ADDRESS+2
        RETURN

GETHEXDISPLAYBYTE: ! FETCH BYTE TO DISPLAY FROM PPADDRESS
        GOSUB 1000
        IF LOCATIONFOUND THEN MEMAD$=HEX$(PPDATA)[4,2] ELSE MEMAD$="xx"
        RETURN

730     ! DISPLAY ASCII BYTE
        LEN(MEMAD$)     =1
        PPADDRESS=ADDRESS \ GOSUB 1000
        IF LOCATIONFOUND THEN MEMAD$[1]=PPDATA ELSE MEMAD$[1]=ASC("X")
        IF      MEMAD$[1]&:7F>:1F AND MEMAD$[1]&:7F<:7F
                THEN PRINT "'";MEMAD$;"'  ";
                ELSE MEMAD$=HEX$(MEMAD$[1]) \
                PRINT MEMAD$[4,2];"  ";

        OPNEXT  =ADDRESS+1
        RETURN

!       SET MODE
800     CHAR$=KEYSTROKE$
        LET CHAR$=UPPERCASE$(CHAR$)
        PRINT   " ";
!       CALL    SYSCALL(READNONE$,'',EMPTY$)
        IF      DOLARFLAG
        THEN    MEMAD$="$" CAT MEMAD$ \
                DOLARFLAG=0 \ SPACEFLAG=0
        IF CHAR$="C" AND COMMAFLAG THEN 1650
        GOSUB   2600
        IF      CHAR$="A" THEN DISPMODE=ASCII \ GOTO 810
        IF      CHAR$="O" THEN DISPMODE=DISASM \ GOTO 810
        IF      MEMAD$<>"" AND CHAR$="H" THEN 1700
        IF      CHAR$="H" THEN DISPMODE=SINGLEHEX \ GOTO 810
        IF      CHAR$="X" THEN DISPMODE=DOUBLEHEX \ GOTO 810
        IF      CHAR$="B" THEN LOADCHANNEL=1\GOTO  850
! *** for BINARYACCESS.ASM:
!       IF      CHAR$="B"
!       THEN
!           IF ERROR WHEN CLOSE #1 THEN REM IGNORE IT
!           CALL INIT(1,BINARYBUFFER$,LOADRECORDINDEX$)
!           GOTO 10
!       FI
        IF      CHAR$="M" THEN IOMODE=MEMORY \ GOTO 10
        IF      CHAR$="D" THEN 820
        IF      CHAR$="S" THEN 1500
        IF      CHAR$="C" THEN 1600
        IF      CHAR$="L" THEN LOADCHANNEL=2 \ GOTO 850
        IF      CHAR$="E"
        THEN
            SYSCALL #0,CCSETACTBLOCK$,NORMALACTIVATION$
            PRINT \ EXIT
        FI
        PRINT   "Might I suggest that you use one of the legal ';' commands?!"
        GOSUB   2702
        GOTO    10
810     IF      CELLOPENFLAG=FALSE THEN GOTO 10
        GOSUB   700
        GOTO    10
820     ON ERROR GOTO 830
        IOMODE  =MEMORY
        CLOSE   #1
830     ON ERROR GOTO 400
        PRINT
        TEMP$=MEMAD$ \ OPEN    #1, TEMP$
        X       =FIND(TEMP$,":")
        IF      X=0 THEN TEMP$="DISK:"
                    ELSE TEMP$=TEMP$[1,X]
        ON ERROR GOTO 835
        CLOSE   #2
835     ON ERROR GOTO 400
        OPEN    #2, TEMP$
        RESTORE #2, :11 \! BOOT:NSPC
        READ    #2, CHAR$
        NSPC    =CHAR$[1]
        CALL    SYSCALL(GETPARAMS$,'',PARAMS$)
        NBPS    =PARAMS$[1]**8+PARAMS$[2]
        CLOSE   #2
        IOMODE  =DISKDUMP
        IOBASE  =0
        PRINT   "nbps = ";HEX$(NBPS);" nspc = ";NSPC
        GOTO    10

850     REM *** PROCESS BINARY LOAD RECORDS *** (;B ;L COMMANDS)
        LRCOUNT=0 \ SKCOUNT=0
        IF LOADCHANNEL=1
        THEN
                IOMODE=MEMORY \ REM IN CASE ERROR WHILE READING LOAD RECORDS
                TOP=-1
        FI
        IF ERROR WHEN CLOSE #LOADCHANNEL THEN REM I DON'T CARE IN THE LEAST...
        ON ERROR GOTO 400
        PRINT
        TEMP$=MEMAD$ \ OPEN #LOADCHANNEL,TEMP$
        LOADRECORDTYPE = 0

!       COMPUTE WHERE ALL THE LOAD RECORDS ARE
!

        CURPOS  =0
        IF LOADCHANNEL=2
        THEN    PRINT "Type","start ad","length","ending address" \
                PRINT "====","========","======","=============="

852     READ #LOADCHANNEL@CURPOS,LOADREC$
        IF EOF(LOADCHANNEL) THEN ERROR 1001
        IF (LOADRECORDTYPE=0 AND LOADREC$[1]=2) THEN LOADRECORDTYPE = 1+1
        ELSE LOADRECORDTYPE = LOADREC$[1]+1
        ON      LOADRECORDTYPE GOTO 860,861,862,863
        PRINT   "Unknown load record encountered (";LOADREC$[1];")"
        GOTO    10

DEF NEXT2BYTES(NEXT2BYTESCHAN)
        READ #NEXT2BYTESCHAN,TWOBYTES$
        IF EOF(NEXT2BYTESCHAN) THEN ERROR 1001
        RETURN TWOBYTES$[1]**8+TWOBYTES$[2]
END

860     LET TEMP=NEXT2BYTES(LOADCHANNEL)
        CURPOS  =CURPOS+3+TEMP
        IF LOADCHANNEL=2 THEN
                PRINT "skip","",HEX$(TEMP)
                SKCOUNT=SKCOUNT+1
        FI
        GOTO    852

861     CURPOS  =CURPOS+5
        LET TEMP=NEXT2BYTES(LOADCHANNEL)
        IF LOADCHANNEL=2 THEN PRINT "start",HEX$(TEMP)
        GOTO    852

862     TEMP$="load"
        GOSUB   864
        GOTO    852

863     TEMP$="go"
        GOSUB   864
        IF LOADCHANNEL=1
        THEN
                IOMODE=BINARY
                PRINT "A total of";TOP+1;"load records"
        ELSE PRINT SKCOUNT;"skip records and";LRCOUNT;"load records"
        GOTO    10

864     IF LOADCHANNEL=1
        THEN
                REM SAVE LOAD RECORD INFO FOR DISPLAY, MODIFY
                REM SHUFFLE RECORDS COLLECTED UP...
                REM SO THAT LOW INDEX RECORDS ARE LAST RECORDS OF FILE
                IF TOP=LEN(LOWER)
                THEN
                        PRINT TOP;"load record limit exceeded"
                        GOSUB POP 0
                        GOTO 3020
                FI
                LET TOP=TOP+1
                FOR I=TOP TO 1 STEP -1
                        LOWER(I)=LOWER(I-1)
                        UPPER(I)=UPPER(I-1)
                        FILEPOS(I)=FILEPOS(I-1)
                NEXT I
                LOWER(0)=NEXT2BYTES(LOADCHANNEL)
                TEMP=NEXT2BYTES(LOADCHANNEL)
                UPPER(0)=LOWER(0)+TEMP-1
                FILEPOS(0) =CURPOS+5
                CURPOS =CURPOS+5+TEMP
        ELSE
                LET TEMP=NEXT2BYTES(LOADCHANNEL)
                LET PPDATA=NEXT2BYTES(LOADCHANNEL)
                PRINT TEMP$,HEX$(TEMP),HEX$(PPDATA),HEX$(TEMP+PPDATA-1)
                CURPOS = CURPOS+5+PPDATA
                LRCOUNT=LRCOUNT+1
        FI
        RETURN
!
!       P E E K
!
1000    LOCATIONFOUND=TRUE \ ! Assume we can find the desired location
        IF      IOMODE<>MEMORY THEN 1001
        PPDATA  =PEEK(PPADDRESS)
        RETURN

1001    IF      IOMODE<>DISKDUMP THEN 1002
        RESTORE #1, PPADDRESS+IOBASE
        READ    #1, PPDATA$
        IF EOF(1)
        THEN PPDATA=0\LOCATIONFOUND=FALSE
        ELSE PPDATA     =PPDATA$[1]
        RETURN

1002    ! FIND PLACE FOR BYTE
        GOSUB   1200
        IF      CURPOS=-1 THEN PPDATA=0\LOCATIONFOUND=FALSE\ RETURN
        RESTORE #1, CURPOS
        READ    #1, PPDATA$
        PPDATA  =PPDATA$[1]
        RETURN

1200    REM SEARCH BINARY LOAD RECORD TABLE FOR PPADDRESS
        REM LOAD RECORDS ARE PLACED IN LIST IN REVERSE ORDER,
        REM SO THAT INDEX VARIABLE DOESN'T HAVE TO GO FLOAT (..STEP -1)
        FOR     CURPOS=0 TO TOP
                IF PPADDRESS>=LOWER(CURPOS) AND PPADDRESS<=UPPER(CURPOS)
                THEN
                        CURPOS=FILEPOS(CURPOS)+PPADDRESS-LOWER(CURPOS)
                        RETURN
                FI
        NEXT    CURPOS
        CURPOS  =-1
!       for BINARYACCESS.ASM:
!       CALL GETBYTE(1,PPADDRESS,PPDATA$)
!       PPDATA  =PPDATA$[1]
        RETURN


!
!       P O K E
!
1100    IF      IOMODE<>MEMORY THEN 1101
        POKE    PPADDRESS, INT(PPDATA)
        RETURN

1101    IF      IOMODE<>DISKDUMP THEN 1102
        RESTORE #1, PPADDRESS+IOBASE
        PPDATA$[1]=INT(PPDATA)
        ON ERROR GOTO 1104
        WRITE   #1, PPDATA$
        ON ERROR GOTO 400
        RETURN
1104    ! CHECK TO SEE IF A DISK WRITE-LOCK ERROR
        ON ERROR GOTO 400
        IF ERR<>:419 THEN 400
        PRINT "Are you sure you want to WRITE on the DISK? ";
        CHAR$=KEYSTROKE$
        LET CHAR$=UPPERCASE$(CHAR$)
        PRINT
        IF      FIND(CHAR$,"Y")<>1 THEN 400
        CALL    SYSCALL(UNLOCK$)
        GOTO    1100

1102    GOSUB   1200
        IF      CURPOS=-1
        THEN    IF UPPER(0)=PPADDRESS-1
                THEN    CURPOS=FILEPOS(0)+PPADDRESS-LOWER(0) \
                        RESTORE #1, FILEPOS(0)-2 \ READ #1, TWOBYTES$ \
                        IF TWOBYTES$[2]=255
                        THEN    TWOBYTES$[1]=TWOBYTES$[1]+1\
                                TWOBYTES$[2]=0
                        ELSE    TWOBYTES$[2]=TWOBYTES$[2]+1 FI \
                        RESTORE #1, FILEPOS(0)-2 \ WRITE #1, TWOBYTES$\
                        UPPER(0)=UPPER(0)+1
                ELSE
                        IF TOP=LEN(LOWER)
                        THEN
                                PRINT TOP; "load record limit exceeded"
                                GOSUB POP 0
                                GOTO 3020
                        FI
                        TOP=TOP+1 \
                        FOR CURPOS=TOP TO 1 STEP -1 DO
                                LOWER(CURPOS)=LOWER(CURPOS-1)
                                UPPER(CURPOS)=UPPER(CURPOS-1)
                                FILEPOS(CURPOS)=FILEPOS(CURPOS-1)
                        END\
                        LOWER(0) =PPADDRESS \ UPPER(0) =PPADDRESS \
                        RESTORE #1, FILEPOS(1)-5 \ CHAR$[1]=2 \
                        WRITE #1, CHAR$ \
                        FILEPOS(0)=FILEPOS(1)+UPPER(1)-LOWER(1)+1 \
                        RESTORE #1, FILEPOS(0) \ CHAR$[1]=3 \
                        WRITE #1, CHAR$ \
                        TWOBYTES$[1]=MSB(PPADDRESS) \
                        TWOBYTES$[2]=LSB(PPADDRESS) \
                        WRITE #1, TWOBYTES$ \ TWOBYTES$[1]=0 \ TWOBYTES$[2]=1 \
                        WRITE #1, TWOBYTES$ \ FILEPOS(0)=FILEPOS(0)+5 \
                        CURPOS=FILEPOS(0)
                FI
        RESTORE #1, CURPOS
        PPDATA$[1]=PPDATA
        WRITE   #1, PPDATA$
!       if BINARYACCESS.ASM
!       CALL PUTBYTE(I,PPADDRESS,PPDATA$)
        RETURN

1300    ! COMMA ... FOR EXTENDED EXAMINE
        GOSUB   2600

        IF      SPACEFLAG
        THEN    MEMAD$=MEMAD$ CAT "," \
                GOTO 20 \ ! OOPS! MUST BE AN ... ,X COMMAND
        IF MEMAD$[1]=ASC("$") THEN MEMAD$=RIGHT$(MEMAD$,2)
        GOSUB 2700
        COMMAAD =INT(VAL(":" CAT MEMAD$))
        COMMAFLAG=TRUE
        GOTO 10
1400    ! EVALUATE EXPRESSION IN TEMP$ AND SET BYTE= RESULT
        IF      LEN(TEMP$)>2
        THEN    IF RIGHT$(TEMP$,LEN(TEMP$)-1)=",X"
                THEN TEMP$=TEMP$[1,LEN(TEMP$)-2]

        FOR     X=1 TO LEN(TEMP$)
                IF NOT(FIND(HX$,TEMP$[X,1])) THEN 2701
        NEXT    X

        BYTE    =VAL(":" CAT TEMP$)
        RETURN

1500    ! SET IOBASE TO SECTOR #
        IF      IOMODE<>DISKDUMP
        THEN    1501
        DOT     =0
        GOSUB   2700
        IOBASE  =NBPS*VAL(":" CAT MEMAD$)
        COMMAAD =0
        MEMAD$  =HEX$(NBPS-1)
        MEMAD$  =MEMAD$(2,4)
        COMMAFLAG       =TRUE
        PRINT
        GOTO    300

1501    ! GIVE ERROR
        PRINT
        PRINT   "That doesn't make sense in this I/O mode!"
        GOSUB 2702
        GOTO 10

1600    ! SET IOBASE TO CLUSTER #
        IF      IOMODE<>DISKDUMP
        THEN    1501
        DOT     =0
        GOSUB   2700
        IOBASE  =NBPS*NSPC*VAL(":" CAT MEMAD$)
        COMMAAD =0
        MEMAD$  =HEX$(NBPS-1)
        MEMAD$  =MEMAD$[2,4]
        COMMAFLAG       =TRUE
        PRINT
        GOTO    300

1650 REM CALCULATE CHECKSUM OVER RANGE OF ADDRESSES
        IF MEMAD$[1]=ASC("$") THEN MEMAD$=RIGHT$(MEMAD$,2)
        GOSUB 2700
        LET PPADDRESS=VAL(':' CAT MEMAD$)
        IF PPADDRESS<COMMAAD THEN PPADDRESS=PPADDRESS+COMMAAD-1
        CHECKSUM =0
        FOR PPADDRESS=COMMAAD TO PPADDRESS
                GOSUB 1000
                LET CHECKSUM=(CHECKSUM+PPDATA)&:FF
        NEXT PPADDRESS
        PRINT "Checksum = ";HEX$(CHECKSUM)[4,2]
        GOSUB 2702
        GOTO 10

1700    ! FIND HEADER CLUSTER
        X       =FIND(MEMAD$,":")
        IF      X=0 THEN TEMP$="DISK:DIRECTORY.SYS"
                ELSE TEMP$=MEMAD$[1,X] CAT "DIRECTORY.SYS" \
                MEMAD$=RIGHT$(MEMAD$,X+1)

        IF LEN(MEMAD$)<>16 THEN MEMAD$ =MEMAD$ CAT SPACES$[1,16-LEN(MEMAD$)]

        ON ERROR GOTO 1701
        CLOSE   #2
1701    ON ERROR GOTO 400
        OPEN    #2, TEMP$

        LET PPADDRESS=0
1710    READ    #2, FILENAME$, ENTRY$
        IF      EOF(2) THEN PRINT \ CLOSE #2 \ PRINT "File not found" \ GOTO 10
        IF      ENTRY$[3]=0 OR ENTRY$[4]=0 AND ENTRY$[5]=0 OR...
&               FILENAME$<>MEMAD$ THEN PPADDRESS=PPADDRESS+32\ GOTO 1710

        PRINT
        PRINT   "DIRECTORY.SYS entry is at displacement ";hex$(ppaddress)
        PRINT   "Header Cluster is at ";HEX$(ENTRY$[1]**8+ENTRY$[2])
        GOTO    10


1800    ! PLUS OPERATOR
        GOSUB   2700
        OPRVAL=VAL(":" CAT MEMAD$)
        OPRFLAG=PLUS
        GOTO    10

1810    ! MINUS OPERATOR
        IF MEMAD$="" THEN OPRFLAG=NEGATE \ GOTO 10
        GOSUB   2700
        OPRVAL=VAL(":" CAT MEMAD$)
        OPRFLAG=MINUS
        GOTO    10

1820    ! TIMES OPERATOR
        GOSUB   2700
        OPRVAL=VAL(":" CAT MEMAD$)
        OPRFLAG=TIMES
        GOTO 10
1840    GOSUB   2700
        OPRVAL=VAL(":" CAT MEMAD$)
        OPRFLAG=EXCLUSIVEOR
        GOTO    10
1830    GOSUB   2700
        OPRVAL=VAL(":" CAT MEMAD$)
        OPRFLAG=LOGICALAND
        GOTO    10

1850    GOSUB 2700
        OPRVAL=VAL(":" CAT MEMAD$)
        OPRFLAG=LOGICALOR
        GOTO    10


1900    ! PERFORM OPERATION
        GOSUB   2700

        IF OPRFLAG=PLUS
                THEN OPRVAL=VAL(":" CAT MEMAD$)+OPRVAL
        IF OPRFLAG=MINUS
                THEN OPRVAL=OPRVAL-VAL(":" CAT MEMAD$)
        IF OPRFLAG=NEGATE
                THEN OPRVAL=:FFFF XOR VAL(":" CAT MEMAD$) \
                OPRVAL=OPRVAL+1-65536*INT((OPRVAL+1)/65536)
        IF OPRFLAG=TIMES
                THEN OPRVAL=OPRVAL*VAL(":" CAT MEMAD$)
        IF OPRFLAG=EXCLUSIVEOR
                THEN OPRVAL=OPRVAL XOR VAL(":" CAT MEMAD$)
        IF OPRFLAG=LOGICALAND
                THEN OPRVAL=OPRVAL&INT(VAL(":" CAT MEMAD$))

        IF OPRFLAG=LOGICALOR
                THEN OPRVAL=OPRVAL!INT(VAL(":" CAT MEMAD$))


        OPRVAL=OPRVAL+65536
        OPRVAL=OPRVAL-65536*INT(OPRVAL/65536)
        IF LEN(MEMAD$)<3 AND OPRVAL<256
                THEN MEMAD$=HEX$(OPRVAL) \
                MEMAD$=MEMAD$[4,2]
                ELSE MEMAD$=HEX$(OPRVAL) \
                MEMAD$=MEMAD$[2,4]

        OPRFLAG =FALSE
        RETURN
2000    ! PRINT MEMAD$
        PRINT MEMAD$;
        GOTO    20

2100    ! GET A CHAR IN ASCII MODE
        LET CHAR$=KEYSTROKE$
        REM DON'T FOLD WHEN ENTERING QUOTED TEXT!
        TEMP$   =HEX$(CHAR$[1])
        MEMAD$  =MEMAD$ CAT TEMP$[4,2]
        DOLARFLAG=TRUE \! SO THAT WE CAN TYPE 'A/ 
        IF      OPRFLAG<>FALSE THEN GOSUB 1900
        GOTO    20

2200    PRINT   "HELP! I'M LOST"
        ON ERROR GOTO 0
        PRINT   "PERHAPS THERE IS A MEMORY FLAKE?!?"
        STOP

2300    IF SPACEFLAG THEN 20
        IF LEN(MEMAD$)>4
        THEN    PRINT "There is no way that could possibly be an opcode..."\
                GOSUB 2702 \
                GOTO 10
        BEFORESPACE$=MEMAD$
        SPACEFLAG=TRUE
        GOSUB   2600
        GOTO 10

2400    IF MEMAD$<>""
        THEN    1840 \
                ! THIS IS SO WE DON'T HAVE ANY PROBLEMS
        IMEDIATE=TRUE
        GOTO    10

2500    IF MEMAD$<>""
                THEN MEMAD$=MEMAD$ CAT "$"\
                GOTO 20

        DOLARFLAG=TRUE
        GOTO    10

2600    ! CHECK TO SEE IF THE COMMAFLAG IS ACTIVE, ERROR IF TRUE

        IF      NOT(COMMAFLAG) THEN RETURN
        GOSUB POP 0
        PRINT   "Comma not valid in this context"
        SPACEFLAG=0
        COMMAFLAG=0
        GOTO    10

2700    ! MAKE SURE THE THING IN MEMAD$ IS REALLY A HEX NUMBER

        IF      LEN(MEMAD$)=0 THEN 2701
        FOR     X=1 TO LEN(MEMAD$)
                IF NOT(FIND(HX$,MEMAD$[X,1])) THEN 2701
        NEXT    X

        RETURN

2701    GOSUB POP 0
        PRINT   "That is not a valid hex number!"
        GOSUB   2702
        GOTO    10

2702    OPRFLAG =FALSE
        COMMAFLAG=FALSE
        DOLARFLAG=FALSE
        CELLOPENFLAG=FALSE
        SPACEFLAG=FALSE
        IMEDIATE=FALSE
        STARTADFLAG=FALSE
        RETURN

3000    ! CONVERT BINARY NUMBER TO HEX
        X=0
        IF LEN(MEMAD$)=0
        THEN    PRINT \
                PRINT "% comes after the binary number" \
                GOSUB 2702 \
                GOTO 10
        FOR     I=1 TO LEN(MEMAD$)
                X=X+X
                IF MEMAD$[I]&:7E<>ASC('0')
                THEN    PRINT \
                        PRINT "That is not a valid binary number..." \
                        GOSUB 2702 \
                        GOTO 10
                X=X+MEMAD$[I]-ASC('0')
        NEXT    I

        IF      LEN(MEMAD$)<9
        THEN    MEMAD$=HEX$(X) \ MEMAD$=MEMAD$[4,2]
        ELSE    MEMAD$=HEX$(X) \ MEMAD$=MEMAD$[2,4]
        GOTO    20
3010    ! CONVERT DECIMAL NUMBER
        IF MEMAD$=""
        THEN    PRINT \
                PRINT "\ comes after the decimal number" \
                GOSUB 2702 \
                GOTO 10

        X=VAL(MEMAD$) \ MEMAD$=HEX$(X)
        IF X>255
        THEN    MEMAD$=MEMAD$[2,4]
        ELSE    MEMAD$=MEMAD$[4,2]
        GOTO    20

3020    ! ESCAPE -- ABORT LINE
        PRINT "  -> command aborted"
        GOSUB 2702
        GOTO 10

3030    ! SET START ADDRESS
        IF IOMODE<>BINARY THEN 1501
        RESTORE #1, 1
        READ    #1, TWOBYTES$
        TEMP$   =HEX$(TWOBYTES$[1]**8+TWOBYTES$[2])
        PRINT   TEMP$[2,4];" ";
        STARTADFLAG=TRUE
        GOTO    10

3040    ! DEPOSIT INTO START ADDRESS
        X       =VAL(":" CAT MEMAD$)
        TWOBYTES$[1]=MSB(X)
        TWOBYTES$[2]=LSB(X)
        RESTORE #1, 1
        WRITE   #1, TWOBYTES$
        TWOBYTES$[1]=:FF-MSB(X)
        TWOBYTES$[2]=:FF-LSB(X)
        WRITE   #1, TWOBYTES$
        GOSUB 2702
        GOTO 10

4000    ! SEARCH CONTROL
        IF MEMAD$="" THEN 4300
        READ    #0, CHAR$
        CHAR$[1]=CHAR$[1]&:7F
        CHAR$=UPPERCASE$(CHAR$)
        PRINT   CHAR$;" ";
        IF      CHAR$="S" THEN 4150
        IF      CHAR$="T" THEN 4100
        IF      CHAR$="M" THEN 4200
        PRINT   " Please use a legal ? command..."
        GOSUB   2702
        GOTO    10

4200    ! SET MASK
        GOSUB 2700
        IF LEN(MEMAD$)&1 THEN MEMAD$="0" CAT MEMAD$
        LEN(MASK$)=INT(LEN(MEMAD$)/2)
        FOR I=1 TO LEN(MASK$) DO
                MASK$[I]=COM(VAL(":" CAT MEMAD$[(I-1)*2+1,2]))&:FF
        END
        GOSUB 2702
        GOTO 10

4100    ! SET TARGET
        GOSUB 2700
        IF LEN(MEMAD$)&1 THEN MEMAD$="0" CAT MEMAD$
        LEN(TARGET$)=INT(LEN(MEMAD$)/2)
        FOR I=1 TO LEN(TARGET$) DO TARGET$[I]=VAL(":" CAT MEMAD$[(I-1)*2+1,2])
        IF LEN(MASK$)<>LEN(TARGET$) THEN
                LEN(MASK$)=LEN(TARGET$)
                FOR I=1 TO LEN(MASK$) DO MASK$[I]=:FF
        FI
        GOSUB   2702
        GOTO    10

4150    ! SEARCH FOR TARGET
!       CALL SYSCALL(READNONE$,"",EMPTY$) \ ! TURN ON ESC KEY!!
        IF MEMAD$[1]=ASC("$") THEN MEMAD$=RIGHT$(MEMAD$,2)
        GOSUB   2700
        FINISHAD        =VAL(":" CAT MEMAD$)
        IF      FINISHAD<256 AND LEN(MEMAD$)<3 THEN FINISHAD=FINISHAD+COMMAAD
        STARTAD =COMMAAD
        IF      STARTAD>FINISHAD OR NOT(COMMAFLAG)
        THEN    PRINT "What?" \
                GOSUB 2702 \ GOTO 10
        PRINT
        IF FINISHAD>:FFFF-LEN(TARGET$)+1 THEN FINISHAD=:FFFF-LEN(TARGET$)+1
        IF LEN(MASK$)<>LEN(TARGET$) THEN
                PRINT "The mask and target lengths must be the same!!"
                GOSUB 2702
                GOTO 10
        FI
        FOR     I=STARTAD TO FINISHAD DO
                PPADDRESS=I \ GOSUB 1000 \ ! GET CONTENTS OF ADDRESS
                IF PPDATA&MASK$[1]<>TARGET$[1] THEN CYCLE I
                FOR J=2 TO LEN(TARGET$) DO
                        PPADDRESS=I+J-1 \ GOSUB 1000
                        IF PPDATA&MASK$[J]<>TARGET$[J] THEN CYCLE I
                END
                PRINT HEX$(I)[2,4];"/ ";
                FOR J=1 TO LEN(TARGET$) DO
                        PPADDRESS=I+J-1 \ GOSUB 1000
                        PRINT HEX$(PPDATA)[4,2];
                END
                PRINT
        END
        PRINT   "... end of list ..."
        GOSUB 2702
        GOTO    10


4300    PRINT
        PRINT "target="; 
        FOR I=1 TO LEN(TARGET$) DO PRINT HEX$(TARGET$[I])[4,2];
        PRINT " mask="; 
        FOR I=1 TO LEN(MASK$) DO PRINT HEX$(COM(MASK$[I]))[4,2];
        PRINT
        GOSUB   2702
        GOTO    10

        END
END
