;The procedure PEEK and the function POKE written by John Jeppson
;published in SOFTALK magazine: AUG 82 in the article
;BANK SWITCH RAZZLE DAZZLE: Peeking and Poking the Apple ///
        .MACRO  POP
        PLA
        STA     %1
        PLA
        STA     %1+1
        .ENDM
        
        .MACRO  PUSH
        LDA     %1+1
        PHA
        LDA     %1
        PHA
        .ENDM
        
ADDRESS .EQU    0E8                     ;zeropage "pseudo" register
BANKSW  .EQU    0FFEF
ZEROPG  .EQU    0FFD0
ENVRMT  .EQU    0FFDF
        
        .FUNC   PEEK,2

        JMP     BEGIN
RETURN  .WORD   0
XBYTE   .WORD   0
RESULT  .WORD   0
OLDXBT  .BYTE   0
OLDZPG  .BYTE   0
ENV     .BYTE   0

BEGIN   POP     RETURN

        PLA                             ;"dummy" bytes for function
        PLA
        PLA
        PLA
        
        POP     XBYTE                   ;parameters come off in reverse order
        POP     ADDRESS
        
        LDA     ADDRESS+1601            ;save original x-byte value
        STA     OLDXBT 
             
             ;which bank is desired
        LDA     XBYTE
        CMP     #0FF                    ;FF = ROM #1, C0-CF = I/O,
        BEQ     SPECIAL                 ;     "true" 00 and 01 pages
                                                 
        CMP     #80
        BMI     SYSTEM                  ;80-8F=extended addressing
        CMP     #90                     ;      else system bank (ordinary 6502)
        BMI     EXTEND

             ;handle system bank
SYSTEM  LDY     #0
        STY     ADDRESS+1601            ;xbyte = 0  so get ordinary 6502
        LDA     @ADDRESS,Y              ;   indirect indexed addressing
        STA     RESULT
        JMP     DONE

             ;handle extended addressing to a bankpair or $8F
EXTEND  STA     ADDRESS+1601            ;place extend byte
        LDY     #0
        LDA     @ADDRESS,Y              ;"extended" addressing to desired
        STA     RESULT                  ;      bank pair
        JMP     DONE

             ;handle artifical bank 'FF'
SPECIAL LDA     ADDRESS+1
        BEQ     TRUEPGS                 ;true $00, $01 desired?
        CMP     #1
        BEQ     TRUEPGS
        
             ;ROM#1 --> F000-FFFF,  C000-CFFF --> I/O
        PHP                             ;save status, then disable interrupts
        SEI                             ;(an "illegal" move)
        LDA     ENVRMT                  ;save environment
        STA     ENV
        LDA     #73                     ;#% 0111 0011 - new environment reg
        STA     ENVRMT                  ;(an "illegal" move)
        LDY     #0
        STY     ADDRESS+1601            ;system bank xbyte = 00
        LDA     @ADDRESS,Y
        STA     RESULT
        
        LDA     ENV                     ;restore ENVRMT
        STA     ENVRMT
        PLP                             ;restore status (including interrupts)
        JMP     DONE
        
            ;desired address on true 00 or 01 page
TRUEPGS PHP                             ;save status, then disable interrupts
        SEI                             ;(an "illegal" move)
        LDX     ADDRESS                 ;load BEFORE leaving old z-page
        LDY     ADDRESS+1
        LDA     ZEROPG                  ;save old zpg
        STA     OLDZPG 
        LDA     #0                      ;changes zero-page to 0, stack to 1
        STA     ZEROPG                  ;(an "illegal" move)
        
        TYA                             ;is high byte 00 or 01
        BEQ     $1     
        
        LDA     0100,X                  ;indexed addressing  (x = addr)
        JMP     $2

$1      LDA     0000,X
        
$2      STA     RESULT
        LDA     OLDZPG                  ;restore ZEROPG (and stack page)
        STA     ZEROPG
        PLP                             ;restore interrupts (status)

DONE    LDA     OLDXBT                  ;restore Pascal's xbyte
        STA     ADDRESS+1601
        
        PUSH    RESULT
        PUSH    RETURN
        RTS
         
        
        .PROC   POKE,3

        JMP     BEGIN

RETURN  .WORD   0
XBYTE   .WORD   0
VALUE   .WORD   0
OLDXBT  .BYTE   0
OLDZPG  .BYTE   0
OLDENV  .BYTE   0                      
ENV     .BYTE   0

BEGIN   POP     RETURN                  ;parameters come off in reverse order
        POP     VALUE
        POP     XBYTE    
        POP     ADDRESS
             
        LDA     ADDRESS+1601            ;save original x-byte value
        STA     OLDXBT 
        
        LDA     ENVRMT                  ;save ENVRMT
        STA     OLDENV           
        AND     #0F7                    ;for POKE, enable write C000 to FFFF
        STA     ENVRMT
             
             ;which bank is desired
        LDA     XBYTE
        CMP     #80
        BMI     $1                      ;80-8F=extended addressing
        CMP     #90                     ;      else system bank (ordinary 6502)
        BMI     EXTEND

             ;disallow certain addresses 
$1      LDA     ADDRESS+1               ;POKE disallowed at (system bank): 
        CMP     #0FF                    ;            BANKSW = FFEF
        BNE     $2                      ;            ENVRMT = FFDF
                                        ;            ZEROPG = FFD0
        LDA     ADDRESS  
        CMP     #0D0                    ; in this program - suicide certain
        BEQ     DONE                    ; in your program - suicide probable
        CMP     #0DF   
        BEQ     DONE                    ;if you really want to crash, just star

        CMP     #0EF                    ;   POKing into SOS (RAM $B800 - FFFF)
        BEQ     DONE                    ;     soon he will get very sick
        
             ;detect artificial bank 'FF'
$2      LDA     XBYTE
        CMP     #0FF                    ;FF = ROM #1, C0-CF = I/O
        BEQ     SPECIAL                 ;     "true" 00 and 01 pages
                                                 
             ;handle system bank
SYSTEM  LDY     #0
        STY     ADDRESS+1601            ;xbyte = 0  so get ordinary 6502
        LDA     VALUE                   ;   indirect indexed addressing
        STA     @ADDRESS,Y
        JMP     DONE

             ;handle extended addressing to a bankpair or $8F
EXTEND  STA     ADDRESS+1601            ;place extend byte
        LDY     #0
        LDA     VALUE
        STA     @ADDRESS,Y              ;"extended" addressing to desired
                                        ;      bank pair
        JMP     DONE

             ;handle artifical bank 'FF'
SPECIAL LDA     ADDRESS+1
        BEQ     TRUEPGS                 ;true zp or $01 desired?
        CMP     #1
        BEQ     TRUEPGS
        
             ;ROM#1 --> F000-FFFF,  C000-CFFF --> I/O
        PHP                             ;save status, then disable interrupts
        SEI                             ;(an "illegal" move)
        LDA     ENVRMT                  ;save environment
        STA     ENV
        
        LDA     #73                     ;#% 0111 0011 - new environment reg
        STA     ENVRMT                  ;(an "illegal" move)
        LDY     #0
        STY     ADDRESS+1601            ;system bank xbyte = 00
        LDA     VALUE
        STA     @ADDRESS,Y

        LDA     ENV                     ;restore ENVRMT
        STA     ENVRMT
        PLP                             ;restore status (including interrupts)
        JMP     DONE
        
            ;desired address on true 00 or 01 page
TRUEPGS PHP                             ;save status, then disable interrupts
        SEI                             ;(an "illegal" move)
        LDX     ADDRESS                 ;load BEFORE leaving old z-page
        LDY     ADDRESS+1
        LDA     ZEROPG                  ;save old zpg
        STA     OLDZPG 
        LDA     #0                      ;changes zero page to 0, stack to 1
        STA     ZEROPG                  ;(an "illegal" move)
        LDA     VALUE                   
                                        
        CPY     #0                      ;is high byte 00 or 01
        BEQ     $1     
        
        STA     0100,X                  ;indexed addressing  (x = addr)
        JMP     $2
        
$1      STA     0000,X
        
$2      LDA     OLDZPG                  ;restore ZEROPG (and stack page)
        STA     ZEROPG
        PLP                             ;restore interrupts (status)

DONE    LDA     OLDXBT                  ;restore Pascal's xbyte
        STA     ADDRESS+1601
        
        LDA     OLDENV                  ;restore C0-CF read/write status
        STA     ENVRMT
        
        PUSH    RETURN
        RTS
        
        .END