AMIGODOS/AMIGODOSREL.ASM
hexsane 34ce2f8293 Upload files to ''
Signed-off-by: hexsane <hexsane@noreply.localhost>
2022-03-15 00:12:43 +00:00

1251 lines
29 KiB
NASM

;
; Originally coded in 2009 by Matthew A. Hudson hexsane
; at gmail.com
; Code style & format borrowed from CFFA v1 source code
; use ca65 to assemble (options elude me as I wrote this code
; over a decade ago as I type this)
;
; HP-IB AMIGO protocol ROM replacement for genuine Apple II GP-IB controller.
;
; Was assembled and working for floppy drive in HP9133xv
; It will work with the hard drive but you will need to change the
; geometry and re assemble.
;
; Note about assembly: I had to offset the code by either 128 or 256 bytes
; (meaning you lose that space in the ROM) but I can't recall why. You may
; need to fiddle around with options to get it in the correct location to
; make the card happy. I've forgotten most of the Apple II I/O layout at this
; point in time.
;
; There is probably code in here from other sources but I couldn't recall from
; who at this point. If you see something that needs credit please let me know
; and I will happily do so.
;
; Constant equates and 'magic' numbers
;
CR = $0D ; ASCII carriage return
RDY = $AE ; offset in ROM to "READY." message
VBLNK = $20 ; mask for vertical blank bit in VIA
OFFM = $00 ; turns off AUTO, TRACE or STEP
POSMSK = $7F ; mask to force positive byte
AUTOM = $01 ; AUTO mode marker
TRACEM = $02 ; TRACE mode marker
STEPM = $03 ; STEP mode marker
SCREEN = $8000 ; SCREEN RAM starting location
TKNTO = $A4 ; BASIC token for TO statement
TKNMIN = $AB ; BASIC token for minus sign: -
MAXLIN = $F9FF ; maximum line number for BASIC (63999)
BASPG = $B4 ; BASIC page for direct mode CHRGET call
; ; -- Handle new BASIC line input page.
VERSION = 0
; Zero page locations
;
COUNT = $0005 ; temporary byte storage for counters, etc.
_FLAG1 = $0009 ; Misc. flag or index value
TMPINT = $0011 ; integer temp
_STRPTR = $001F ; pointer to string variable
_TMPTR0 = $0021 ; temporary pointer to BASIC text
_BASPTR = $0028 ; pointer to start of BASIC program
_VARPTR = $002A ; pointer to start of BASIC variables
_ARRPTR = $002C ; pointer to start of BASIC arrays
_MEMSZ = $0034 ; highest memory location used by BASIC
CURRLN = $0036 ; current BASIC line number
_VARNAM = $0042 ; current VARIABLE name
_VARADR = $0044 ; address of VARIABLE
TMPTR1 = $0055 ; temporary storage for integers or pointers
TMPTR2 = $0057 ; " "
TMPTR3 = $005C ; " "
CYLH = $0055
CYLL = $0056
HEAD = $0057
SECTOR = $0058
_FACCM = $005F ; f.p. mantissa (int. storage for conversion)
CHRGET = $0070 ; The infamous BASIC character/token fetch
CHRGOT = $0076 ; get last character
TXTPTR = $0077 ; pointer into BASIC program
MODE = $007C ; OFF, AUTO, STEP or TRACE marker (0,1,2 or 3)
_LINNUM1 = $0080 ; work area and storage for BASIC line
_LINNUM2 = $0082 ; numbers used by AUTO and RENUMBER
_TMPTR4 = $0084 ; temporary pointer
_TMPTR5 = $0086 ; temporary pointer or byte storage (see below)
_TMPERR = $0086 ; temporary offset to char used by HELP routine
A0BYTE = $A0
A5BYTE = $A5
ACBYTE = $80
BTBYTE = $81
EFBYTE = $82
MXHEAD = $83
MXSECTOR = $84
MXCYLH = $85
MXCYLL = $86
;SPARE1 = $82
;BYBYTE = $82
SAVEX = $0087 ; temporary storage for BASIC 'x' register
_STATUS = $0096 ; BASIC status byte
_SHIFTKEY = $0098 ; SHIFT key pressed = 1, not pressed = 0
_LDVERF = $009D ; LOAD/VERIFY flag for cassette
_NUMCHR = $009E ; number of characters in keyboard buffer
_REVFLG = $009F ; screen reverse field flag
TAPETMP1 = $00C7 ; temporary pointers for tape handler
_TAPETMP2 = $00C9 ; " " "
_FNLEN = $00D1 ; number of characters in file name
DEVID = $00D4 ; device ID
DISKNUM = $033b ; D# from command line.
_TAPBUFF = $00D6 ; pointer to start of tape buffer
;
; stack page
;
STKPAG = $0100
;
; BASIC input buffer
;
INBUFF = $0200 ; direct mode input buffer and work area
KEYBUFF = $026F ; BASIC keyboard buffer
;
; cassette buffer
;
SAFTMP1 = $03E0 ; safe temporary when cassette #2 not used
SAFTMP2 = $03E1 ; " " "
STEPSZ = $03E2 ; line spacing for AUTO and RENUMBER
LNBUFF = $03E4 ; Line buffer for TRACE and STEP scrolling
TRCBUF = $03E6 ; buffer for displayed TRACE lines (integers)
;
; BASIC entry points
;
KWDLST = $C092 ; list of BASIC keywords
PRTERR = $C355 ; print error message
ERRMSG = $C377 ; print ERROR
RDYMSG = $B3FF ; print READY.
FIXLINKS = $C439 ; reset BASIC line links
LOOKUP = $b4fb ; get BASIC token for keyword
FINDLINE = $C52C ; get ptr to BASIC line. num ($11), ptr: ($5C)
RST_PTRS = $C572 ; reset BASIC pointers to default values
RD_INT = $C873 ; convert ASCII string to integer in $11,$12
PUT_CRLF = $C9DE ; print CR/LF to device
PUT_STRING = $bb1d ; prepare and print ASCII string to device
PRTSTR = $CA22 ; print string
PUTCHR = $bb46 ; print character
SYNERR = $CE03 ; display ?SYNTAX ERROR msg
LOCVAR = $D069 ; find an f.p. variable by name
FX2FLT = $D26D ; convert fixed point to floating point
LDFACC = $DAAE ; load f.p. number fo FACC1
INT2FP = $DB55 ; convert integer to f.p.
PRTLIN = $DCD5 ; print line number
PRTINT = $cf83 ; print integer in a(hi),x(lo)
CNV_PRT = $DCE3 ; convert f.p. in FACC1 to ASCII and print
FP2ASC = $DCE9 ; convert to ASCII string at bottom of stack
;PARSEDOS = $de2c ; Parse DOS BASIC command line
PARSEDOS = $dc68 ; Parse DOS BASIC command line
PRTHEX = $d722 ; Print A as HEX to output
;
; Screen editor
;
NUMCHK = $d3aa ; clear carry if 'a' contains ASCII digit
;
; I/O ports
VIA = $E840 ; misc. operating system flags and VBLANK
;
; Kernel (kernal) entry points
;
PRTMON = $F156 ; print MONITOR message at index in 'y'
PRTLOAD = $F3E6 ; print LOAD message
PRTRDY = $F3EF ; print READY. message
PRTSRCH = $F40A ; print SEARCHING message
GETPARM = $F47d ; get device parameters
GETHDR = $F494 ; get tape program header
PRTFNF = $F56E ; print FILE NOT FOUND message
SRCH_HDR = $F5A6 ; search tape for next header
RD_HDR = $F63C ; get tape program start & end addresses
SET_BUFF = $F656 ; set buffer start address
WT_PLAY = $F812 ; wait for cassette PLAY switch
RD_TAPE = $F85E ; read cassette tape
WT_IO = $F8E6 ; wait for I/O completion
STOPKEY = $FFE1 ; check for stop key and restart BASIC
; IEEE 488
NRFDOUT = $e840
NDACOUT = $e821
EOIOUT = $e811
DAVOUT = $e823
HIGH = $3c
LOW = $34
DATAOUT = $e822
DATAIN = $e820
NRFDIN = $e840
DAVIN = $e840
ATNOUT = $e840
NDACIN = $e840
EOIIN = $e810
;
; AMIGO DOS START
;
; Call with SYS(28672)
;
;.segment "szzz"
;.org $7000
.word *+2
;.segment "STARTUP"
;.code
AMIGODOS: jmp INITROM ; Toolkit initialization.
; Need jump table here.
INITROM: ldx #$07 ; Initialize Toolkit ROM.
@B: lda WEDGE-1,x ; Gopy 'wedge' to CHRGET
sta TXTPTR+1,x ; following TXTPTR.
dex
bne @B
lda #<CPYRT ; Display PAICs copyright
ldy #>CPYRT ; notice.
jsr PUT_STRING
lda #$05
sta DEVID ; Set default DEVICE BYTE FIXME
lda #$00
sta A0BYTE
sta EFBYTE
rts
;jmp INITVAR ; Initialize Toolkit vars.
;
; 'wedge' code for insertion in CHRGET routine
;
WEDGE: jmp AD_ENTRY
brk ; Location for MODE byte.
jmp AD_CONT
;
; This is the entry point for the Toolkit 'wedge' code. Normal BASIC
; calls to the CHRGET routine are intercepted to test for Toolkit
; command processing. If no Toolkit action is performed, BASIC is
; continued.
;
AD_ENTRY: pha ; Toolkit entry from CHRGET wedge.
stx SAVEX ; Save 'x' register for BASIC.
lda TXTPTR+1 ; Test for direct mode:
cmp #>INBUFF ; - are we pointing into
bne @F ; the BASIC buffer? ($02XX)
lda TXTPTR
cmp #<INBUFF ; - start of buffer? ($0200)
beq SCNBUF ; Branch if in Direct mode.
bne MODCHK ; Branch always.
@F: lda TXTPTR
; sta TMPERR ; We're in program space
MODCHK: lda MODE ; Check mode.
; beq RTNBAS ; Just continue if mode = OFF(0/BRK).
; bne @F
;@F: jmp RTNBAS ; NOT USING MODES
RTNBAS: ldx SAVEX ; Restore 'x' register.
pla ; Get saved character
cmp #'9'+1 ; and set up for a
bcs AD_EX ; return to BASIC.
AD_CONT: cmp #' ' ; Continue with BASIC.
bne @F ; Skip spaces.
jmp CHRGET
@F: jmp NUMCHK ; Clear carry if number.
AD_EX: rts
SCNBUF:
tsx ; Start scan of BASIC buffer.
lda STKPAG+3,x ; Check previous caller loc.
cmp #BASPG ; BASIC direct mode?
bne MODCHK ; IF not, check mode byte.
ldy #$00 ; ELSE scan buffer.
sty COUNT
;
; Scan the BASIC input buffer (in direct mode) and test the character
; string for a match with one of the DOS commands. The count of the
; found command is used to index into a jump table, (ADADDRHI & ADADDRLO)
;
FNDCMD: ldx #$FF
@B: inx ; Scan buffer.
lda INBUFF,x
bmi MODCHK
cmp #' '
beq @B ; Skip spaces.
CMDLP: lda CMDLIST,y ; Get next character from
beq MODCHK ; list of Toolkit cmds.
eor INBUFF,x
bne @skf
iny ; Bump indices on every
inx ; matched character.
bpl CMDLP
@skf:
cmp #$80 ; Accept keyword if mismatch
beq GOTTKN ; is caused by terminator.
@skb: iny ; Otherwise skip characters
lda CMDLIST-1,y ; to next keyword.
bpl @skb
inc COUNT ; Update keyword counter.
bne FNDCMD ; Branch always (try next cmd).
GOTTKN: inc TXTPTR ; Bump TXTPTR past this
dex ; keyword. No need to bump
bne GOTTKN ; HIGH byte (always $02).
ldx COUNT
cpx #$02
bmi @F
pla
pla
@F: pla
lda ADADDRHI,x ; Execute Toolkit command.
pha
lda ADADDRLO,x
pha
rts
TEST: .byte "HERE I AM", $0D, $00
;
; This is the DOS keyword (command) list. The last character in each
; string has the high bit set to facilitate keyword counting.
;
CMDLIST:.byte "loo",'p'|128
.byte "ds",'j'|128
.byte "statu",'s'|128
.byte "see",'k'|128
.byte "heade",'r'|128
.byte $00
;
; DOS command dispatch table. The DOS commands are
; preceded with an underscore to facilitate browsing the
; program source code.
;
; high bytes of Toolkit routine entry points
;
ADADDRHI:.byte >(_LOOP-1)
.byte >(_DSJ-1)
.byte >(_STAT-1)
.byte >(_SEEK-1)
.byte >(_HEADER-1)
;
; low bytes of Toolkit routine entry points
;
ADADDRLO:.byte <(_LOOP-1)
.byte <(_DSJ-1)
.byte <(_STAT-1)
.byte <(_SEEK-1)
.byte <(_HEADER-1)
GO_BAS:
lda #$FF
sta CURRLN+1
jmp RDYMSG
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LISTEN Command 30 TALK Command 30
;; LOOPBACK Test
;;
_LOOP: lda #$00
sta A0BYTE
sta EFBYTE
lda #$05
sta DEVID
jsr LISTEN
lda #$1e ; Write Loopback Record
sta ACBYTE
jsr SECLIST
lda #65
sta ACBYTE
jsr QOUT
lda #66
sta ACBYTE
jsr QOUT
lda #67
sta ACBYTE
jsr QOUT
lda #68
sta ACBYTE
jsr QOUT
lda #69
sta ACBYTE
jsr QOUT
jsr PPUNL
jsr TALK
lda #$1e ;Read Loopback record
sta ACBYTE
jsr SECTALK
@B: jsr QIN
lda ACBYTE
jsr PUTCHR
lda EFBYTE
beq @B
jsr UNTALK
jmp GO_BAS
.IF 0
PRTHEXI:
pha
lsr
lsr
lsr
lsr
clc
adc #48
cmp #58
bmi @F1
clc
adc #7
@F1:
jsr PUTCHR
pla
and #$0f
clc
adc #48
cmp #58
bmi @F2
clc
adc #7
@F2:
jsr PUTCHR
rts
.ENDIF
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DOS Command HEADER - Format Disk
;;
_HEADER:lda #$00
sta A0BYTE
sta EFBYTE
jsr CHRGET
jsr LOOKUP
jsr CHRGET
jsr PARSEDOS
;jsr FORMAT ; FIXME ENABLE
; FIXME Will need identify table for these values.
lda #2
sta MXHEAD
lda #16
sta MXSECTOR
lda #35
sta MXCYLL
lda #0
sta MXCYLH
;Track 0 Sector 0
lda #$00
sta HEAD
sta CYLH
sta CYLL
sta SECTOR
jsr SEEK
jsr OWRITE
; Output data to be written to sector (256 Bytes Max)
lda #VERSION ; Our version #
sta ACBYTE
jsr QOUT
lda #00 ; # or tracks (cylinders) hi
sta ACBYTE
jsr QOUT
lda #35 ; # of tracks (cylinders) lo
sta ACBYTE
jsr QOUT
lda #16 ; # of sectors per track
sta ACBYTE
jsr QOUT
lda #2 ; # of heads
sta ACBYTE
jsr QOUT
lda #1 ; #of Partitions
sta ACBYTE
jsr QOUT
lda #00 ; Partition start track
sta ACBYTE
jsr QOUT
lda #01
sta ACBYTE
jsr QOUT
lda #00 ; Partition end track
sta ACBYTE
jsr QOUT
lda #34
sta ACBYTE
jsr QOUT
jsr CWRITE
;Track 18 Sector 0
lda #$00
sta HEAD
sta CYLH
sta SECTOR
lda #18
sta CYLL
jsr SEEK
jsr OWRITE
lda #<(T18SC0)
sta TAPETMP1
lda #>(T18SC0)
sta TAPETMP1+1
jsr BUILDSECTOR
jsr CWRITE
;Track 18 Sector 1
jsr NXTSECTOR
jsr SEEK
jsr OWRITE
lda #<(T18SC1)
sta TAPETMP1
lda #>(T18SC1)
sta TAPETMP1+1
jsr BUILDSECTOR
jsr CWRITE
;Track 18 Sector 2
jsr NXTSECTOR
jsr SEEK
jsr OWRITE
lda #<(T18SC2)
sta TAPETMP1
lda #>(T18SC2)
sta TAPETMP1+1
jsr BUILDSECTOR
jsr CWRITE
;Track 18 Sector 3
ldx #3
@NXTDIRSEC:
jsr NXTSECTOR
jsr SEEK
jsr OWRITE
lda #18
inx
cpx #32
bne @NOTLAST
lda #0
ldx #$ff
@NOTLAST:
sta ACBYTE
jsr QOUT
txa
sta ACBYTE
jsr QOUT
jsr CWRITE
cpx #$ff
bne @NXTDIRSEC
jsr CWRITE
jmp GO_BAS
BUILDSECTOR:
ldy #$00
sty COUNT
@NXTBYTE:
inc COUNT
lda (TAPETMP1), y
iny
cmp #$80
bmi @SEND
cmp #$ff ;$ff = End
beq @DONE
cmp 'n'|128 ;n+high bit = name
bne @f1
ldx #$00 ;FIXME NEED TO VALIDATE FILE NAME/DISK NAME
@NXTFNCHAR:
lda $0342,x
sta ACBYTE
jsr QOUT
inx
cpy $d1
bne @NXTFNCHAR
lda #$10
sec
sbc $d1
beq @NXTBYTE
tax
@NXTSSPC:
lda #$a0
sta ACBYTE
jsr QOUT
dex
bne @NXTSSPC
jmp @NXTBYTE
@f1:
cmp 'i'|128 ;i+high bit = Disk ID
bne @f2
lda $033f
sta ACBYTE
jsr QOUT
lda $0340
sta ACBYTE
jsr QOUT
@f2:
cmp 'r'|128 ;repeat group
bne @f3
lda (TAPETMP1), y
pha ; push counter
iny ; offset to restore
@NXTGROUP:
tya
pha ; push restore offset
jsr @NXTBYTE
pla
tsx
dec $100,x
beq @GROUPDONE
tay ;restore offset
jmp @NXTGROUP
@GROUPDONE: ;Y should be set beyond the group
pla
jmp @NXTBYTE
@f3:
and #$80
sta COUNT
lda (TAPETMP1), y ;Repeat COUNT times
iny
@SEND: sta ACBYTE
jsr QOUT
dec COUNT
bne @SEND
jmp @NXTBYTE
@DONE:
rts
NXTSECTOR:
ldx #0
inc HEAD
lda HEAD
cmp MXHEAD
beq @INCSECTOR
rts
@INCSECTOR:
stx HEAD
inc SECTOR
lda SECTOR
cmp MXSECTOR
beq @INCCYLL
rts
@INCCYLL:
stx SECTOR
clc
lda CYLL
adc #1
bcs @INCCYLH
sta CYLL
cmp MXCYLL
beq @ERROR
rts
@INCCYLH:
stx CYLL
lda CYLH
adc #1
bcs @ERROR
sta CYLH
cmp MXCYLH
beq @ERROR
rts
@ERROR:
;FIXME NEED ERROR HERE
lda #'e'
jsr PUTCHR
lda #$0d
jsr PUTCHR
brk
; Track 18, Sector 0
T18SC0: .byte 18, 3, 0, 0, 'n'|128, 'i'|128, $81, $a0, 0, 0, $82, $a0, $ff
; Track 18 Sector 1
T18SC1: .byte 18, 2, 0, 0, 'i'|128, 0, 0, 8|128, 0
.byte 31, 1|128, $fe, 4|128, $ff
.byte 'r'|128, 16, 32, 5|128, $ff, $ff
.byte 6|128, 0
.byte 'r'|128, 17, 32, 5|128, $ff, $ff
.byte 'r'|128, 5, 6|128, 0, $ff
.byte $ff
; Track 18 Sector 2
T18SC2: .byte 0, $ff, 0, 0, 'i'|128, 0, 0, 8|128, 0
.byte 'r'|128, 35, 32, 5|128, $ff, $ff
.byte 'r'|128, 5, 0, 5|128, 0, $ff
.byte $ff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LISTEN Command 12 TALK OpCode 24
;; FORMAT Low level format the drive for sector writing.
;; (Internal Subroutine)
;;
FORMAT: lda #$00
sta A0BYTE
sta EFBYTE
lda #$05
sta DEVID
jsr LISTEN
lda #12 ;FORMAT Command
sta ACBYTE
jsr SECLIST
@B:
lda #24
sta ACBYTE
jsr QOUT
lda DISKNUM
sta ACBYTE
jsr QOUT
lda #$80
sta ACBYTE
jsr QOUT
lda #9
sta ACBYTE
jsr QOUT
lda #0
sta ACBYTE
jsr QOUT
jsr PPUNL
rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LISTEN Command 8 TALK Command 8
;; Request Status / Send Status
;;
_STAT: lda #$00
sta A0BYTE
sta EFBYTE
jsr CHRGET
jsr LOOKUP
jsr CHRGET
jsr PARSEDOS
lda DEVID
bne EXSTAT
lda #$05
sta DEVID
EXSTAT: jsr STAT
lda #<ST1
ldy #>ST1
jsr PUT_STRING
lda TMPTR1
jsr PRTHEX
lda TMPTR1+1
jsr PRTHEX
lda #$0d
jsr PUTCHR
lda #<ST2
ldy #>ST2
jsr PUT_STRING
lda TMPTR1+2
jsr PRTHEX
lda TMPTR1+3
jsr PRTHEX
lda #$0d
jsr PUTCHR
jmp GO_BAS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Request Status / Send Status (Internal Subroutine)
;;
STAT:
jsr LISTEN
lda #8 ; Request Status
sta ACBYTE
jsr SECLIST
lda #3
sta ACBYTE
jsr QOUT
lda DISKNUM ; Disk (Unit) Number
sta ACBYTE
jsr QOUT
jsr PPUNL
jsr TALK
lda #8 ;Send Status
sta ACBYTE
jsr SECTALK
jsr QIN
lda ACBYTE
sta TMPTR1
jsr QIN
lda ACBYTE
sta TMPTR1+1
jsr QIN
lda ACBYTE
sta TMPTR1+2
jsr QIN
lda ACBYTE
sta TMPTR1+3
@B: jsr QIN
lda ACBYTE
lda EFBYTE
beq @B
jsr UNTALK
rts
ST1: .asciiz "st1:$"
ST2: .asciiz "st2:$"
STDSJ: .asciiz "dsj:"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TALK Command 16
;; _DSJ - Device Specified Jump
;;
_DSJ: lda #$00
sta A0BYTE
sta EFBYTE
jsr CHRGET
jsr LOOKUP
jsr CHRGET
jsr PARSEDOS
lda DEVID
bne @HAVEDV
lda #$05
sta DEVID
@HAVEDV:jsr DSJ
lda #<STDSJ
ldy #>STDSJ
jsr PUT_STRING
lda TMPINT
clc
adc #48
jsr PUTCHR
lda #$0d
jsr PUTCHR
jmp GO_BAS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DSJ - Device Specified Jump (Internal Subroutine)
;;
DSJ: jsr TALK
lda #16 ;Get DSJ
sta ACBYTE
jsr SECTALK
@B: jsr QIN
lda ACBYTE
sta TMPINT
lda EFBYTE
beq @B
jsr UNTALK
rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LISTEN Command 8 OpCode 2
;; _SEEK - Seek drive head to DISKNUM,CYLH,CYLL,HEAD,SECTOR
;;
_SEEK: lda #$00
sta A0BYTE
sta EFBYTE
jsr CHRGET
jsr LOOKUP
jsr CHRGET
jsr PARSEDOS
lda DEVID
bne @HAVEDV
lda #$05
sta DEVID
@HAVEDV:jsr SEEK
jsr DSJ
lda TMPINT
beq @SKIPSTAT
lda #<STDSJ
ldy #>STDSJ
jsr PUT_STRING
lda TMPINT
clc
adc #48
jsr PUTCHR
lda #$0d
jsr PUTCHR
jmp EXSTAT
@SKIPSTAT:
jmp GO_BAS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SEEK Seek drive head to D#,CYLH,CYLL,HEAD,SECTOR
;; (Internal Subroutine)
;;
SEEK: lda DEVID
jsr LISTEN
lda #8 ;Get DSJ
sta ACBYTE
jsr SECLIST
@B:
lda #'s'
jsr PUTCHR
lda #$0d
jsr PUTCHR
lda #$02
sta ACBYTE
jsr QOUT
lda DISKNUM
sta ACBYTE
jsr QOUT
lda CYLH
sta ACBYTE
jsr QOUT
lda CYLL
sta ACBYTE
jsr QOUT
lda HEAD
sta ACBYTE
jsr QOUT
lda SECTOR
sta ACBYTE
jsr QOUT
jsr PPUNL
rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; _WRITE - Buffered Write to current seeked sector.
;;
_WRITE: lda #$00
sta A0BYTE
sta EFBYTE
jsr CHRGET
jsr LOOKUP
jsr CHRGET
jsr PARSEDOS
lda DEVID
bne @HAVEDV
lda #$05
sta DEVID
@HAVEDV:;jsr OWRITE
jsr DSJ
lda TMPINT
beq @SKIPSTAT
lda #<STDSJ
ldy #>STDSJ
jsr PUT_STRING
lda TMPINT
clc
adc #48
jsr PUTCHR
lda #$0d
jsr PUTCHR
jmp EXSTAT
@SKIPSTAT:
jmp GO_BAS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OWRITE - OPEN Buffered Write to current seeked sector
;; (Internal Subroutine)
;; 256 Byte sectors must be written as a whole. (partial sectors filled with 00)
;;
OWRITE: jsr LISTEN
lda #9 ;Buffered Write
sta ACBYTE
jsr SECLIST
@B:
lda #'w'
jsr PUTCHR
lda #$0d
jsr PUTCHR
lda #$08
sta ACBYTE
jsr QOUT
lda DISKNUM
sta ACBYTE
jsr QOUT
rts
; lda $fc ;
; pha
; lda $fb ; Start Address for write
; pha
; lda $ca ;
; pha
; lda $c9 ; End Address for write
; pha
; FIXME Buffer in 2 chunks of 128 bytes.
; OR 192 Bytes followed by 64 bytes? (It would be consistant
; with the way CBM did it)
; lda SECTOR
; sta ACBYTE
; jsr QOUT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CWRITE - CLOSE Buffered Write to current seeked sector
;; (Internal Subroutine)
;; 256 Byte sectors must be written as a whole. (partial sectors filled with 00)
;;
CWRITE:
jsr PPUNL
rts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Using Accumulator to hold byte out
TALK: lda #$40
jmp TSKIP
LISTEN: lda #$20
TSKIP: sta ACBYTE
sta BTBYTE ;store variables
lda #$02
ora NRFDOUT
sta NRFDOUT ;NRFD high
lda #HIGH
sta NDACOUT ;NDAC high
lda A0BYTE
beq @NOEOI ;IF A0 = 0 branch
lda #LOW
sta EOIOUT ;EOI LOW
jsr IEEEOUT
lda #$00
sta A0BYTE
lda #HIGH
sta EOIOUT ;EOI HIGH
@NOEOI:
lda BTBYTE
ora DEVID
sta A5BYTE
lda #HIGH
sta DAVOUT
@DAVINCHK:
lda #$80
bit DAVIN
beq @DAVINCHK ;Wait for DAV HIGH
lda DAVIN
and #$fb
sta ATNOUT ;ATN LOW
; Write Byte with handshaking to IEEE Bus
; can't use x, y
IEEEOUT:
lda #HIGH
sta DAVOUT ;DAV OUT HIGH
lda NRFDIN
and #$41
cmp #$41 ;Does the device exist?
beq NODEVICE
lda A5BYTE
eor #$ff ;Invert bits (IEEE-488 is active low)
sta DATAOUT
NRFDCHK:
lda #$64
bit NRFDIN
beq NRFDCHK
lda #LOW
sta DAVOUT ;DAV OUT LOW
UNKCHK: lda #$01
bit NRFDIN
beq UNKCHK ;This is in the BASIC source Why?
lda #HIGH
sta DAVOUT ;DAV OUT HIGH
lda #$ff
sta DATAOUT ;DATA high
rts
NODEVICE:
lda #<DEVNF
ldy #>DEVNF
jsr PUT_STRING
jmp GO_BAS
; Send Secondary Listen Address
SECLIST:
lda ACBYTE
ora #96
sta ACBYTE ;FIXME Need to save this?
sta A5BYTE
jsr IEEEOUT
ATNHI: lda ATNOUT
ora #$04
sta ATNOUT
rts
; Send Secondary Talk Address
SECTALK:
lda ACBYTE
ora #96
sta ACBYTE
sta A5BYTE
jsr IEEEOUT
lda NRFDOUT
and #$fd
sta NRFDOUT ;NRFD OUT LOW
lda #LOW
sta NDACOUT ;NDAC OUT LOW
jmp ATNHI
;Send untalk command
UNTALK: lda ATNOUT
and #$fb
sta ATNOUT ;ATN OUT HIGH
lda #$5f
jsr TSKIP
jmp ATNHI
; Write queued bytes to IEEE BUS
; can't use x, y
QOUT: lda A0BYTE
and #$80
bne A0MAXED
lda A0BYTE
sec
sbc #$01
sta A0BYTE
bmi QBYTE
lda #$ff
sta A0BYTE
jmp QBYTE
A0MAXED:
; lda ACBYTE
;sta BYBYTE
jsr IEEEOUT
;lda BYBYTE
;sta ACBYTE
QBYTE: lda ACBYTE
sta A5BYTE
rts
; Read from the IEEE BUS
QIN:
lda #HIGH
sta DAVOUT
lda #LOW
sta NDACOUT
lda NRFDOUT
ora #$02
sta NRFDOUT ;NRFD OUT HIGH
@B1: lda DAVIN
and #$80
bne @B1 ;Wait for DAV LOW.
lda NRFDOUT
and #$fd
sta NRFDOUT ;NRFD OUT LOW
lda #$40
bit EOIIN
bne @F
lda EFBYTE
ora #$40
sta EFBYTE
@F:
lda #$ff
sec
sbc DATAIN
sta ACBYTE
;sta BYBYTE
lda #HIGH
sta NDACOUT
@B2: lda #$80
bit DAVIN
beq @B2 ;Wait for DAV HIGH
lda #LOW
sta NDACOUT
rts
; UNLISTEN With Parallel Polling.
PPUNL: lda #63
sta ACBYTE
sta BTBYTE
lda NRFDOUT
ora #$02
sta NRFDOUT ;NRFD high
lda #HIGH
sta NDACOUT ;NDAC high
lda A0BYTE
cmp #$00
beq @F
lda #LOW
sta EOIOUT ;EOI LOW
jsr IEEEOUT
lda #HIGH
sta EOIOUT ;EOI HIGH
lda #$00
sta A0BYTE
@F: lda BTBYTE
ora DEVID
sta A5BYTE
lda #HIGH
sta DAVOUT
@B: lda DAVIN
and #$80
beq @B ;Wait for DAV HIGH
CHKPOLL:
lda #LOW
sta EOIOUT ;EOI LOW
lda ATNOUT
and #$fb
sta ATNOUT ;ATN LOW (EOI + ATN = Parallel Poll)
ldx #$06
jsr JIFDLY
ldy DATAIN ;Y Holds the POLL
lda #HIGH
sta EOIOUT ;EOI HIGH
lda ATNOUT
ora #$04
sta ATNOUT ;ATN HIGH
lda #$08
sec
sbc DEVID
tax
lda #$00
sec
@B: rol
dex
bne @B ;HP-IB devices respond to poll on DIO# = 8 - device ID
sta TMPINT
tya
and TMPINT
bne CHKPOLL
lda ATNOUT
and #$fb
sta ATNOUT
jsr IEEEOUT
jmp ATNHI
; X = # delay loops
JIFDLY: lda $8f
@B: cmp $8f
beq @B
dex
bne JIFDLY
rts
;
; Matthew Hudson Copyright
;
CPYRT: .byte "(c) 2009 matthew a hudson"
.byte $0D
.byte $00
DEVNF: .byte "device not found!"
.byte $0D
.byte $00
.end