;------------------------------------------------------------------------
;
;		Copyright 2006 Intergraded Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;        title   'Mio diagonistic tool for the mio'
;
;------------------------------------------------------------------------
;                              miodiag.s
;
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;------------------------------------------------------------------------
; Notes: o This source code MAY NOT be placed for download on any BBS's!
;        o "mea" is a macro that loads the address of the first field
;          into the pointer specified by the second field.
;------------------------------------------------------------------------
; Assembler:  MADMAC (tm) ST Cross Assembler (Atari Corp)
;             XASM   st and IBM VERSIONS
;------------------------------------------------------------------------

savmsg    equ     $58
zoch      equ     $80
oup       equ     $82
memp      equ     $84

zp        equ     $D3
dptr      equ     $d5

brkflg    equ     $11     ; break flag


; MIO registers
; -------------
rampage   equ     $D1E0   ; write ram page address
dain      equ     $D1E1   ; HD data input
daout     equ     $D1E1   ; HD & printer data out
inputs    equ     $D1E2   ; monitor handshake lines
miscout   equ     $D1E2   ; several misc outputs (ramdisk, displays, etc)
irqstat   equ     $D1FF   ; read IRQ status
setrom    equ     $D1FF   ; write ROM bank address
rststro   equ     $D1E0   ; strobe reset low (goes high on read of INPUTS)

; Bit definition of INPUTS
; ------------------------
prfault   equ     $10     ; printer fault
prbusy    equ     $40     ; printer busy
hdcd      equ     $01     ; hard disk command/data
hdmsg     equ     $02     ; MSG input
hdio      equ     $04     ; hard disk input/output control
hdbusy    equ     $20     ; hard disk busy line
hdreq     equ     $80     ; hard disk request line

; Bit definitions of MISCOUT
; --------------------------
ramhi     equ     $0F     ; ram high 4 bits of address (mask)
selstro   equ     $10     ; select LOW bit...
ramen     equ     $20     ; ram enable bit
prstro    equ     $40     ; printer strobe output
prirqen   equ     $80     ; enable printer IRQ on NOT busy


		.org   $600

ztemp     ds.b      1
zch       ds.b      1
loop      ds.b      2
comp      ds.b      2
curbank   ds.b      1
curpage   ds.b      1
chp       ds.b      1
chp2      ds.b      1
curlin    ds.b      1
xsave     ds.b      1
maxbank   ds.b      1
lcount    ds.b      1
keydel    ds.b      1
srtimr    ds.b      1
ch1       ds.b      1
check     ds.b      2
ocheck    ds.b      2


;         HardIO variables
;         ----------------
command   ds.b      10
comlen    ds.b      2       ; length of command

blockln   ds.b      2
senseb    ds.b      4
hdirect   ds.b      1       ; direction...
busid     ds.b      1       ; SCSI controller ID     (unitID)
unit      ds.b      1       ;  unit number on controller (LUN)


screen:		equ     $9C40   ; start of screen
;screen:		equ	$7c40


datsc     equ     screen+280   ; 7 lines on top of main page


	   .org   $a000

;          defseg  romarea,start=$A000
;          seg     romarea
	  
	  lda     #low carini
	  sta     12
	   lda    #high carini
	   sta    13
	  jmp     carini


;         Start of menu program
;         ---------------------
menu      
	  ldx     #$ff
	  txs
	  jsr     clear

	  jsr     inidat
	  jsr     add40
	  ldy     #0
	  jsr     print
	   dc.b     "D. Display Page     B. Burn In",-1
	  jsr     add40
	  jsr     print
	   dc.b     "R. Read Location    L. Write Latch",-1
	  jsr     add40
	  jsr     print
	   dc.b     "W. Write Location   F. Firmware Test",-1
	  jsr     add40
	  jsr     print
	   dc.b     "H. HardDisk Read    P. PIO HD Read",-1
ink2      jsr     dstatus
ink       jsr     getkey
	  bcc     ink2
	  beq     ink
	  cmp     #'D'
	  beq     jdis
	   cmp    #'R'
	   beq    jrloc
	  cmp     #'W'
	  beq     jwloc
	   cmp    #'B'
	   beq    jburn
	  cmp     #'L'
	  beq     jwlat
	   cmp    #'H'
	   beq    jhardr
	  cmp     #'F'
	  beq     jfirm
	   cmp    #'P'
	   beq    jpio
	  jmp    ink
jrloc     jmp     csload
jdis      jmp     dispage
jwloc     jmp     cssave
jburn     jmp     burnin
jwlat     jmp     tlatch
jhardr    jmp     hardr
jfirm     jmp     firm
jpio      jmp     pio
	  



;*****************************************
;         Hard Disk Call through PIO
;*****************************************

pio       
	  jsr     $e465
	  jsr     $e450
	  jsr     $e49b

	  jsr     clear
	  jsr     disform
..fistar  lda     #0
	  sta     loop
	  sta     loop+1
	  sta     comp
	  sta     comp+1
	  jsr     dstatus         ; display status screen
..again   jsr     piorea          ; read page at $D600 into $4000
	  jsr     dispg           ; display page
	   inc    loop
	   bne    ..cx
	    inc   loop+1
..cx      jsr     dstatus
	  jsr     getkey
	  bcc     ..fistar
	  bcs     ..again
	  


piorea    
	  jsr     firmge
	  lda     curpage
	  sta     $30a
	   lda    curbank
	   sta    $30b
	  lda     #0
	  sta     $308
	   lda    #1
	   sta    $309
	  lda     #$40
	  sta     $303
	   lda    #$52
	   sta    $302
	  lda     #$31
	  sta     $300
	   lda    #1
	   sta    $301
	  lda     #0
	  sta     $304
	   lda    #7
	   sta    $305
	  lda     #$40
	  sta     $306
	  jsr     $e459
	  bpl     ..ok1
	   inc    comp+1
..ok1     rts
	  




;***********************************
;         Hard Disk Read Test
;***********************************

hardr     
	  lda     #0
	  sta     busID
	  sta     unit

;         jsr     setcom
;          dc.b     6,0,0,0,0,0,0
;         jsr     hard
;          dc.w     0,0
;          dc.b     0

	  jsr     clear
	  jsr     disform
..fistar  lda     #0
	  sta     loop
	  sta     loop+1
	  sta     comp
	  sta     comp+1

	  jsr     firmge
	  ldy     #0
..lop2    lda     (memp),y
	  sta     $4000,y
	   iny
	   bne    ..lop2
	  jsr     showchk

	  jsr     dstatus         ; display status screen
..again   jsr     firmge
	  jsr     hardpg          ; read page at $D600 into $4000
	  jsr     dispg           ; display page
	  ldy     #0
..lop     lda     (memp),y
	  sta     $4000,y
	   iny
	   bne    ..lop
	  jsr     showchk
	  lda     ocheck
	  cmp     check
	  bne     ..err
	   lda    ocheck+1
	   cmp    check+1
	   beq    ..ok
..err     inc     comp            ; an error

..ok      lda     check
	  sta     ocheck
	   lda    check+1
	   sta    ocheck+1
	   inc    loop
	   bne    ..cx
	    inc   loop+1
..cx      jsr     dstatus
	  jsr     getkey
	  bcc     ..fistar
	  bcs     ..again
	  

firmge    
	  ldy     #0
	  lda     curpage
	  and     #7
	  ora     #$D8
	  sta     memp+1
	   lda    #0
	   sta    memp
	  ldx     curbank
	   lda    mymask,x
	   sta    $D1FF
	  rts
	  

showsen   
;         lda     #low screen+40*6
	  lda     #low screen+240
	  sta     oup
	   lda    #high screen+240
	   sta    oup+1
	  ldy     #0
	  jsr     print
	   dc.b     "SENSE: ",-1
	  lda     senseb
	  jsr     prby
	  jsr     print
	   dc.b     " ",-1
	  lda     senseb+1
	  jsr     prby
	  jsr     print
	   dc.b     " ",-1
	  lda     senseb+2
	  jsr     prby
	  jsr     print
	   dc.b     " ",-1
	  lda     senseb+3
	  jsr     prby
	  rts
	  


hardpg    
	  jsr     setcom
	   dc.b     6
	   dc.b     8,0,0,0,1,0
	  lda     curpage
	  sta     command+3
	   lda    curbank
	   sta    command+2

	  jsr     hard
	   dc.w     $4000,256
	   dc.b     0
	  bpl     ..ok11
	   inc    comp+1          ; failed totally
	   jmp    ..skip

..ok11    and     #2
	  beq     ..ok12
	   inc    comp            ; bad return status
..ok12
..skip    ldx     #0
..loop    lda     $4000,x
	  eor     #$ff
	  sta     $4000,x
	   inx
	   bne    ..loop
	  rts
	  




;===============================================
;         Hard Drive support functions
;===============================================

;         Set command frame for hard drive I/O
;         ------------------------------------
setcom    
	  pla
	  sta     zp
	   pla
	   sta    zp+1
	  ldy     #1
	  lda     (zp),y
	  sta     comlen
	  tax
..setop    iny
	   lda    (zp),y
	   sta    command-2,y
	  dex
	  bne     ..setop
	  tya
	  clc
	  adc     zp
	  tax
	   lda    #0
	   adc    zp+1
	   pha
	  txa
	  pha
	   lda    command+1
	   ora    unit            ; LUN
	   sta    command+1
	  rts
	  


;         Hard drive command execute
;         --------------------------
hard      
	  pla
	  sta     zp
	   pla
	   sta    zp+1
	  ldy     #1
	  lda     (zp),y
	  sta     dptr
	   iny
	   lda    (zp),y
	   sta    dptr+1
	  iny
	  lda     (zp),y
	  sta     blockln
	   iny
	   lda    (zp),y
	   sta    blockln+1
	  iny
	  lda     (zp),y
	  sta     hdirect
	   tya
	  clc
	  adc     zp
	  tax
	   lda    #0
	   adc    zp+1
	   pha
	  txa
	  pha
	  jsr     xhdio
	  bmi     ..bad
	   pha
	   and    #2
	   beq    ..nosts         ; jump if no extended sense...
	  jsr     setcom
	   dc.b     6
	   dc.b     3,0,0,0,4,0
	  jsr     hard
	   dc.w     senseb
	   dc.w     4
	   dc.b     0
..nosts   pla                     ; A = status from main operation
	  cpy     #0
..bad     rts
	  


;         Perform general Hard Disk I/O
;         -----------------------------
xhdio     
	  SEI
	  jsr     hdready         ; check if HD is ready
	   bcs    ..balog         ; exit if error...
	  LDA     INPUTS
	  AND     #HDIO           ; IF INPUT TO US, THEN MUST BE IOMEGA
	  BEQ     ..comer         ;  DRIVE (HARDWARE BUSY)..

	  jsr     sencom          ; send command frame
..wareq   bit     inputs          ; wait for REQ-
	  bmi     ..wareq
	   lda    inputs          ; now must start data phase... if not,
	   and    #hdcd           ;  then must have status... go get
	   beq    ..comer         ;  status
	  jsr     rwdata          ; perform data phase... read/write buffer
..wareb   bit     inputs
	  bmi     ..wareb         ; wait for request (status type request)
	   lda    inputs
	   and    #hdcd           ; must be command (actually status read)
	   bne    ..daer          ; jump if still thinking data
..comer   jsr     hdstat
	   clc
	   CLI
	   ldy    #1
	   rts
..balog   ldy     #$8A            ; give timeout if not REQ given
	   dc.b $2C
..daer    ldy     #$E0            ; give interface error
	  CLI
	  cpy     #0
	  sec
	  rts
	  


;         Read/Write sector buffer
;         ------------------------
rwdata    
	  lda     inputs
	  eor     hdirect
	  and     #hdio
	  bne     rwdata          ; wait until I/O is correct
	   inc    blockln+1
	  bit     hdirect
	  bpl     ..rtop          ; jump if reading data

..wtop    dec     blockln+1
	  bmi     ..fini          ; jump if finished...
	  bne     ..fullw         ; jump if a full page left
	   ldx    blockln
	   beq    ..fini
	   dc.b $2C
..fullw   ldx     #0
	  ldy     #0
..wdata   bit     inputs          ; wait for request...
	  bmi     ..wdata
	  lda     (dptr),y
	  eor     #-1
	  sta     daout           ; send data to HD
	   iny
	   dex
	   bne    ..wdata
	  inc     dptr+1
	  jmp     ..wtop

..rtop    dec     blockln+1
	  bmi     ..fini          ; jump if finished...
	  bne     ..fullr         ; jump if a full page left
	   ldx    blockln
	   beq    ..fini
	   dc.b $2C
..fullr   ldx     #0
	  ldy     #0
..rdata   bit     inputs          ; wait for request...
	  bmi     ..rdata
	  lda     dain            ; read data from HD
	  eor     #-1
	  sta     (dptr),y
	   iny
	   dex
	   bne    ..rdata
	  inc     dptr+1
	  jmp     ..rtop
..fini    rts
	  


;         Send command frame to SCSI device
;         ---------------------------------
sencom    
	  ldy     comlen
	  ldx     #0
..neou    lda     command,x
	  eor     #-1
	  sta     daout           ; set output data...
..wareq    bit    inputs
	   bmi    ..wareq
	  inx
	  dey
	  bne     ..neou
	  rts
	  


;         Read hard drive status
;         ----------------------
hdstat    
	  lda     dain
	  ldx     #0
..replp   bit     inputs
	  bpl     ..ldain
	   dex
	   bne    ..replp
	  BEQ     ..LDAIN3
..ldain   ldy     dain            ; remove second status byte just incase
..LDAIN3  eor     #-1
	  and     #$1F            ; strip LUN bit... FIX 9/3/86
	  rts
	  


;         Perform selection of hard disk
;         ------------------------------
hdready   
	  lda     inputs
	  and     #hdbusy         ; if not busy, then go on to selection
	  beq     ..hderr         ;  else jump to error

	  ldx     busID
	  lda     ..scsix,x       ; set unit ID...
	  eor     #-1
	  sta     daout           ; put on data bus...
..waiou    lda    inputs
	   and    #hdio           ; wait until assured that we're output
	   beq    ..waiou
	  lda     #ramen+selstro  ; strobe SELECT low until not BUSY...
	  sta     miscout
	  ldx     #100            ; Must assert BUSY within 200us
..buslp   lda     inputs
	  and     #hdbusy         ; wait until HD goes busy...
	  beq     ..conreq        ; if BUSY, then continue with first REQ
	   dex                    ;  check... else keep looping
	   bne    ..buslp
..hderr   lda     #ramen
	  sta     miscout
	  sec                     ; return with error...
	  rts

..conreq  lda     #ramen          ; restore MISCOUT
	  sta     miscout
	  jsr     waireq          ; wait for request
	  bcs     ..hderr         ;  if never happened... then error
	   lda    inputs
	   and    #hdcd           ; Must be asking for command...
	   bne    ..hderr
	  clc
	  rts

..scsix   dc.b $01,$02,$04,$08,$10,$20,$40,$80
	  


;         Wait for request with timeout
;         -----------------------------
waireq    
	  ldx     #0
..waire   bit     inputs          ; jump if is request
	  bpl     ..isreqw
	   dey
	   bne    ..waire         ; continue checking...
	   dex
	   bne    ..waire
	  sec
	  rts
..isreqw  clc
	  rts
	  



;******************************
;         Burn in test
;******************************

burnin    
	  jsr     clear
	  jsr     dstatus

	  jsr     inidat
	  jsr     add40
	  jsr     print
	   dc.b     " Size: ",-1

	   lda    #$24
	   sta    $D1E2
	  lda     #$AA
	  sta     $D600
	  lsr     $D600
	  lda     $D600
	  cmp     #$55
	  beq     ismeg
	   jsr    print
	    dc.b    "256K",-1
	   lda    #4
	   bne    burn2
ismeg     jsr     print
	   dc.b     "1 Meg",-1
	  lda     #16
burn2     sta     maxbank

	  jsr     add40
	  jsr     print
	   dc.b     "Status: ",-1   ; Y=8 at screen+40*8

	  jsr     clearm

	  lda     #0
	  sta     loop
	  sta     loop+1
	  sta     comp
	  sta     comp+1
	  jsr     dstatus

vtop      lda     #16
	  sta     lcount
	  ldx     maxbank
	  dex
	  txa
	  and     $d20a
	  sta     curbank
	   lda    $d20a
	   sta    curpage
vttop     inc     curpage
	  jsr     setram          ; set rambank
	  jsr     setpg
	  lda     (memp),y
	  beq     mwrit           ; if 0, then must write
	   bit    $d20a
	   bmi    mwrit           ; if rnd neg, then write
	  jsr     verify
	  beq     nlop
	   inc    comp
	   bne    nlop
	    inc   comp+1
	    jmp   nlop
mwrit     jsr     write
nlop      dec     lcount
	  bne     vttop
	   inc    loop
	   bne    ok22
	    inc   loop+1
ok22       jsr    dstatus
	   lda    $2fc
	   cmp    #-1
	   beq    vtop
	   lda    #-1
	   sta    $2fc
	   jmp    menu
	  


rslw      
	  lda     #low screen+320
	  sta     oup
	   lda    #high screen+320
	   sta    oup+1
	  ldy     #8
	  bcc     isr
	   jsr    print
	   dc.b     "W",-1
	   rts
isr       jsr     print
	   dc.b     "V",-1
	  rts
	  


write     
	  lda     $d20a
	  and     #3
	  clc
	  adc     #1
	  sta     (memp),y        ; set new type...
	  pha
	   sec
	   jsr    rslw
	  pla
	  cmp     #2
	  bcc     w1
	  beq     w2
	  cmp     #4
	  bcc     w3
w1
w2
w3
w4        lda     curbank
	  clc
	  adc     curpage
	  ldy     #0
w4lo      sta     $d600,y
	   clc
	   adc    #1
	   iny
	   bne    w4lo
	  rts
	  


verify    
	  pha
	   clc
	   jsr    rslw
	  pla
	  cmp     #2
	  bcc     r1
	  beq     r2
	  cmp     #4
	  bcc     r3
r1
r2
r3
r4        lda     curbank
	  clc
	  adc     curpage
	  ldy     #0
r4lo      cmp     $d600,y
	  bne     nok4
	   clc
	   adc    #1
	   iny
	   bne    r4lo
nok4      rts
	  



;****************************
;         Test firmware
;****************************

firm      
	  jsr     clear
	  jsr     disform
..top     lda     #0
	  sta     loop
	  sta     loop+1
	  sta     comp
	  sta     comp+1
	  jsr     dstatus         ; display status screen
..again   jsr     firmpg          ; read page at $D600 into $4000
	  jsr     dispg           ; display page
	   inc    loop
	   bne    ..cx
	    inc   loop+1
..cx      jsr     dstatus
	  jsr     showchk
	  jsr     getkey
	  bcc     ..top  
	  bcs     ..again
	  


showchk   
	  lda     #low screen+240
	  sta     oup
	   lda    #high screen+240
	   sta    oup+1
	  ldy     #0
	  jsr     print
	   dc.b     "CHECKSUM: ",-1
	  ldx     #0
	  stx     check
	  stx     check+1
..loop    lda     $4000,x
	  clc
	  adc     check
	  sta     check
	  bcc     ..nc
	   inc    check+1
..nc      inx
	  bne     ..loop
	  lda     check+1
	  jsr     prby
	   lda    check
	   jsr    prby
	  rts
	  


firmpg    
	  ldy     #0
	  lda     curpage
	  and     #7
	  ora     #$D8
	  sta     memp+1
	   lda    #0
	   sta    memp
	  ldx     curbank

firtop     lda    mymask,x
	   sta    $D1FF
	  lda     (memp),y
	  sta     $4000,y
	   lda    mymask,x
	   sta    $D1FF
	  lda     (memp),y
	  cmp     $4000,y
	  beq     ok123
	   inc    comp
	   bne    ok123
	    inc   comp+1
ok123     iny
	  bne     firtop
	  rts
	  

mymask    dc.b      $00,$01,$02,$04,$08,$10,$20,$40,$80
	  dc.b      $00,$00,$00,$00,$00,$00,$00



;**************************
;         Latch test
;**************************

tlatch    
	  ldx     #0
tlat2     jsr     setram
	  dex
	  bne     tlat2
	   jsr    getkey
	   bcs    tlatch
	   jsr    dstatus
	   jmp    tlatch
	  


;***********************************************
;         Continous single location load/save
;***********************************************

csload    
	  jsr     getloc
	  stx     xsave
llpp1     ldx     xsave
	  ldy     #0
llpp2     lda     $D600,x
	  dey
	  bne     llpp2
	   jsr    getkey
	   bcs    llpp1
	   jsr    setram
	   jsr    dstatus
	   jmp    llpp1
	  


;         Continous single location save
;         ------------------------------
cssave    
	  jsr     getloc
	  stx     xsave
llpp4     ldx     xsave
	  ldy     #0
llpp3     sta     $D600,x
	  dey
	  bne     llpp3
	   jsr    getkey
	   bcs    llpp4
	   jsr    setram
	   jsr    dstatus
	   jmp    llpp4
	  

getloc    
	  lda     #low screen+240	;120
	  sta     oup
	   lda    #high screen+240	;120
	   sta    oup+1
	  ldy     #0
	  jsr     print
	   dc.b     "Location?",-1
	  jsr     inbyte
	  pha
	   ldy    #8
	   lda    #':'
	   jsr    prch
	  pla
	  tax
	  rts
	  


 
;***********************************
;         Memory sub-routines
;***********************************

setram    
	  lda     curbank
	  ora     #$20
	  sta     $D1E2
	   lda    curpage
	   sta    $D1E0
	  rts
	  


;         Set memory page
;         ---------------
setpg     
	  lda     #0
	  sta     memp
	   lda    #$10
	   clc
	   adc    curbank
	   sta    memp+1
	  ldy     curpage
	  rts
	  


;         clear memory map
;         ----------------
clearm    
	  lda     #0
	  sta     memp
	   lda    #$10
	   sta    memp+1
lop4      ldy     #0
	  tya
lop3      sta     (memp),y
	   iny
	   bne    lop3
	  inc     memp+1
	  lda     memp+1
	  cmp     #$20
	  bne     lop4
	  rts
	  




;***********************************************
;         Continuous display of RAM page
;***********************************************

dispage   
	  jsr     clear           ; clear screen
	  jsr     disform         ; display form page
..start   jsr     setram
	  lda     #0
	  sta     loop
	  sta     loop+1
	  sta     comp
	  sta     comp+1
	  jsr     dstatus         ; display status screen
..again   jsr     readpg          ; read page at $D600 into $4000
	  jsr     dispg           ; display page
	   inc    loop
	   bne    ..cx
	    inc   loop+1
..cx      jsr     dstatus
	  jsr     getkey
	  bcc     ..start
	  bcs     ..again
	  


;         Read memory page
;         ----------------
readpg    
	  ldx     #0
..top     lda     $D600,x
	  sta     $4000,x
	  cmp     $D600,x
	  beq     ..cx
	   inc    comp
	   bne    ..cx 
	    inc   comp+1
..cx       inx
	   bne    ..top   
	  rts
	  



;******************************
;         Input routines
;******************************

;         Get key and execute
;         -------------------
; out:
;         c=0 if changed BANK/PAGE
;         c=1,Z=1 if no key
;         c=1,Z=0 if key (nothing done)

getkey    
	  lda     $2FC
	  cmp     #-1
	  beq     noke
	   and    #$3F
	   tax
	  lda     chtabl,x        ; get char from table
	   ldy    #$FF
	   sty    $2FC
	  cmp     #'-'
	  beq     upa
	   cmp    #'='
	   beq    downa
	  cmp     #27
	  beq     esc1
	   cmp    #'*'
	   beq    righta
	  cmp     #'+'
	  beq     lefta
	   cmp    #'<'
	   beq    left8
	  cmp     #'>'
	  beq     right8
noke       sec
	   rts

lefta     dec     curpage
	  clc
	  rts
righta    inc     curpage
	  clc
	  rts
upa       inc     curbank
	  jmp     o11
downa     dec     curbank
o11       lda     curbank
	  and     #15
	  sta     curbank
	  clc
	  rts
left8     lda     curpage
	  sec
	  sbc     #8
	  sta     curpage
	  clc
	  rts
right8    lda     curpage
	  clc
	  adc     #8
	  sta     curpage
	  clc
	  rts
esc1      jmp     menu
	  

chtabl    dc.b      "LJ;",0,0,"K+*"
	  dc.b      "O",0,"PU",13,"I-="
	  dc.b      "V",0,"C",0,0,"BXZ"
	  dc.b      "4",0,"36",$1B,"521"
	  dc.b      ", .N",0,"M/",$81
	  dc.b      "R",0,"EY",9,"TWQ"
	  dc.b      "9",0,"07",8,"8<>"
	  dc.b      "FHD",0,$82,"GSA"

inbyte    
	  jsr     inbin
	  sta     chp
	  jsr     prnib
	  jsr     inbin
	  sta     chp2
	  jsr     prnib
	  lda     chp
	  asl
	  asl
	  asl
	  asl
	  ora     chp2
	  rts
	  

inbin     
	  jsr     inchar
	  cmp     #'0'
	  bcc     inbin
	   cmp    #':'
	   bcc    num
	   cmp    #'G'
	   bcs    inbin
	   cmp    #'A'
	   bcc    inbin
	   sbc    #7
num       and     #15
	  rts
	  


inchar    
	  lda     $2FC
	  cmp     #-1
	  beq     inchar
	   and    #$3F
	   tax
	  lda     chtabl,x        ; get char from table
	   ldx    #$FF
	   stx    $2FC
	  rts
	  



;************************************
;         Display routines
;************************************

;         display status line
;         -------------------
dstatus   
	  lda     #low screen+200       ;40*5
	  sta     oup
	   lda    #high screen+200      ;40*5
	   sta    oup+1
	  ldy     #0
	  jsr     print
	   dc.b     "BANK:",-1
	  lda     curbank
	  jsr     prby
	  jsr     print
	   dc.b     "  PAGE:",-1
	  lda     curpage
	  jsr     prby
	  jsr     print
	   dc.b     "  LOOP:",-1
	  lda     loop+1
	  jsr     prby
	  lda     loop
	  jsr     prby
	  jsr     print
	   dc.b     "  ERROR:",-1
	  lda     comp+1
	  jsr     prby
	  lda     comp
	  jsr     prby
	  rts
	  


;         display memory page
;         -------------------
dispg     
	  jsr     inidat
	  lda     #0
	  sta     curlin
dispg2    lda     curlin
	  and     #15
	  bne     sk12
	   jsr    add40
	   ldy    #4
	   bne    sk11
sk12      lda     curlin
	  and     #3
	  bne     sk11
	   iny                    ; skip a space if start of group of 4
sk11      ldx     curlin
	  lda     $4000,x
	  jsr     prby            ; print value
	  inc     curlin
	  bne     dispg2
	  rts
	  


;         display address line starts
;         ---------------------------
disform   
	  jsr     inidat
	  jsr     add40
	  lda     #0
tloop     sta     curlin
	  ldy     #0
	  jsr     prby
	   lda    #':'
	   jsr    prch
	  jsr     add40
	  lda     curlin
	  clc
	  adc     #$10
	  bne     tloop
	  rts
	  


;         print byte directly to screen
;         -----------------------------
; in:
;         oup     = ptr into screen
;         Y       = offset from ptr
prby      
	  pha
	  lsr
	  lsr
	  lsr
	  lsr
	  jsr     prnib
	  pla
prnib     and     #$0F
	  ora     #$30
	  cmp     #$3A
	  bcc     prch
	   adc    #6

prch      cmp     #$60
	  bcs     prch2
	   sbc    #$1F
	   bcs    prch2
	  adc     #$60
prch2     sta     (oup),y
	  iny
	  rts
	  


;         Print string of text
;         --------------------
print     
	  tsx
	  lda     $101,x
	  sta     zoch
	   lda    $102,x
	   sta    zoch+1

	  sty     chp
	  ldy     #1
xzoch     lda     (zoch),y
	  cmp     #$ff
	  beq     zecho
	   sty    chp2
	   ldy    chp
	   jsr    prch
	   sty    chp
	   ldy    chp2
	   iny
	   bne    xzoch
zecho     tya
	  ldy     chp
	  clc
	  adc     $101,x
	  sta     $101,x
	   lda    $102,x
	   adc    #0
	   sta    $102,x
	  rts
	  


inidat    
	  lda     #low datsc-40
	  sta     oup
	   lda    #high datsc-40
	   sta    oup+1
	  rts
	  


add40     
	  lda     oup
	  clc
	  adc     #40
	  sta     oup
	  bcc     nc1
	   inc    oup+1
nc1       ldy     #0
	  rts
	  


;         clear screen
;         ------------
clear     
	  lda     #low screen
	  sta     oup
	   lda    #high screen
	   sta    oup+1
	  ldx     #24
cl12      ldy     #39
	  lda     #0
cl11      sta     (oup),y
	   dey
	   bpl    cl11
	  jsr     add40
	  dex
	  bne     cl12

	  lda     #low screen
	  sta     oup
	   lda    #high screen
	   sta    oup+1
	  ldy     #0
	  jsr     print
;	   dc.b     "Multi I/O Diagnostics   Apr 04",-1

		dc.b	" Multi I/O Diagnostics      Feb 13,2010 "
		dc.b	"   Copyright Intergraded Logic Systems  "
;		dc.b	"                                        "
		dc.b	"       Telnet a real Atari BBS          "
		dc.b	" tcpipexpress.com port 8888, 8889, 8890 "
		dc.b	-1
	  rts
	  



;******************************************
;         initialize system (quickly)
;******************************************

carini    
	  jsr     ihw     ; IHW -- initialize hardware registers

	  lda     #low irqhan
	  sta     $216
	   lda    #high irqhan
	   sta    $217

	  lda     #low nmihan
	  sta     $222
	   lda    #high nmihan
	   sta    $223

	  lda     #low dlist
	  sta     $d402
	   lda    #high dlist
	   sta    $d403           ; dlist

	  lda     #$22
	  sta     $d400   ; dmactl
	   lda    #1
	   sta    $d401   ; chactl
	  lda     #$e0
	  sta     $d409   ; chbase

	  lda     #$80    ;74
	  sta     $d018   ; color in PF2
	   lda    #$ff    ;0a
	   sta    $d017   ; lum in PF1

	  lda     #$40
	  sta     $d40e   ; NMIEN
	   lda    #$40
	   sta    $10
	   sta    $d20e   ; IRQEN

	  lda     #$13
	  sta     $d20f   ; key board enable
	  sta     $d20a

	  lda     #-1
	  sta     $2fc

	  lda     #0
	  sta     keydel
	  sta     srtimr
	  sta     curpage
	  sta     curbank
	  CLI
	  jmp     menu    ; finally enter MENU
;          


dlist     dc.b      $70,$70,$70,$42
	  dc.w      $9c40
	  dc.b      $10,2,2,2,2,$10,2,2,$20
	  dc.b      2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,$41
	  dc.w      dlist



;         IRQ handler for key board
;         -------------------------
irqhan    
	  pha
	   lda    $d20E   ; irqst
	   and    #$40
	   bne    noi
	   lda    #$BF
	   sta    $d20E
	   lda    $10
	   sta    $d20E
	   jsr    keybd
noi       pla
	  rti
 


keybd     
	  txa
	  pha
	  tya
	  pha
	  lda     $d209   ; kbcode
	  cmp     ch1
	  bne     kir1
	   ldx    keydel
	   bne    kir8    ; must delay more
kir1      sta     $2fc
	  sta     ch1
	   lda    #3
	   sta    keydel
kir8      lda     #24
	  sta     srtimr
	  pla
	  tay
	  pla
	  tax
	  rts
 
 

;         NMI handler for key board
;         -------------------------
nmihan    
	  lda     $d20f   ; SKSTAT
	  and     #4
	  beq     ivn11   ; jump if key down
	   lda    keydel  ; jump if key up and counted down
	   beq    ivn11
	    dec   keydel
ivn11     lda     srtimr  ; repeat timer
	  beq     ivn13   ; jump if expired
	  lda     $d20f
	  and     #4
	  bne     ivn12   ; jump if key up
	   dec    srtimr
	   bne    ivn13
	  lda     #3
	  sta     srtimr  ; reset repeat counter
	  lda     $d209
	  sta     $2fc
	  jmp     ivn13
ivn12      lda    #0
	   sta    srtimr
ivn13     pla
	  tay
	   pla
	  tax
	  pla
	  rti
 


;         initialize hardware
;         -------------------
ihw       
	  lda     #0
	  tax
	  sta     $D303
ihw1      sta     $d000,x
	  sta     $d400,x
	  sta     $d200,x
	  cpx     #1
	  beq     ihw2
	   sta    $d300,x
ihw2      inx
	  bne     ihw1

	  lda     #$3c
	  sta     $d303
	   lda    #$ff
	   sta    $d301
	  lda     #$38
	  sta     $d302
	  sta     $d303
	   lda    #0
	   sta    $d300
	  lda     #$ff
	  sta     $d301
	   lda    #$3c
	   sta    $d302
	   sta    $d303
	  lda     $d301
	  lda     $d300

	  lda     #$22
	  sta     $d20f   ; SKCTL

	  lda     #$a0
	  sta     $d205
	  sta     $d207   ; audc3,4

	  lda     #$28
	  sta     $d208

	  lda     #$ff
	  sta     $d20d   ; serout
	  rts


;You would need to set a cart of for this.

;	 .org   $bff0	;       seg     segbff0
;
;	  sta     $D5E0   ; switch to bank 0 (initially set here)
;	  jmp     carini
;	 dc.w      0,0
;	 dc.w      0       ; run address
;	 dc.b      0       ; (0 indicatess cartridge presense)
;	 dc.b      $80     ; special execution desired
;	 dc.w      $BFF0
;
win_end:	ds.b	0
;
;
;
;