.SBTTL	65816 version - Ted Medin & Mark Johnson

;	Version 1.0

;	Based on the KERMIT Protocol.

;	$Header: appgs.m65,v 1.7 90/10/15 14:21:04 medin Locked $
.SBTTL	Define start address for assembly

       .=$1003			; Start assembly at hex 1003

debug	=	1		;[1.4] debug flag - when 0 will not add debug code

.SBTTL	Revision History

;
; Edit #	Description
; ------	-----------
;

; $Log:	appgs.m65,v $
Revision 1.7  90/10/15  14:21:04  medin
new org for 3.87 of $7f00
version 1.6

;Revision 1.6  89/11/06  11:42:28  medin
; Use xon/xoff or dtr but not both

;Revision 1.5  89/01/30  11:39:24  medin
; Version 1.4 add drop dtr and correct some debug problems.

;Revision 1.4  88/01/15  08:43:21  medin
;New origin for 3.81



; DONT FORGET TO UPDATE THE VERSION

;
;
;	Vector for com cards starts here 
;		location $1003 for data
;		location $1020 for routine jumps
;		location $1040 for main routines
;
sscdbd:	.blkb	1  ;contains baud index(ala super serial card) used by init
			;		6 - 300 baud
			;		7 - 600 
			;		etc
	.blkb	1	
crdnam:	.word	herld	; null terminated string of who we are
kersli:	.blkb	1	; com slot $n0
kerins:	.blkb	1	; force initialization flag-when 0
endker:	.blkb	2	; address of end of main kermit
flowfg:	.blkb	1	; flow flag for xon/xoff controll b7=1 yes
tl0end	.word	endcom	;[1.3] end of this routine
timect	.blkb	1	;[1.4] 1 ms delay via rom wait rtn
	.=$1020		; future expansion
tlinit:	jmp	tl2int		; initialize com card
tl0cmd:	jmp	tl2cmd		; command for ACIA in A
			;
			; 0 - hang up 
			; $0b - set baud
			; $0c - set break on the line
			; $91 - xon
			; $93 - xoff
			;
			; routine will return false(0) if unable
tl0cp:	jmp	tl2cp		; check for input ch ready-0 false
tl0gpc:	jmp	tl2gpc		; get input ch
tl0ppc:	jmp	tl2ppc		; put output character
tl0exi:	jmp	tl2exi		; reset card and restore initialized
	.=$1040		; futures
;[1.2]wait:	.blkb	3	; wait routine-a reg contains milliseconds
wait:	.blkb	3	; wait routine-apple rom rtn 220=125ms,206=108ms,25=2ms ...
prstr:	.blkb	3	; print string x=lsb,y=msb x&y->null terminated string
rdkey:	.blkb	3	; read keyboard
prcrlf:	.blkb	3	; print cr and lf
telcnc:	.blkb	3	; check for keyboard character
telspa:	.blkb	3	; set character parity

	.=$7f00	; place to start com card assembly
start	=	.		;need a label at begining
true	=	1		; true is non zero
false	=	0		; but not false
irqsva	=	$45	;place dos saves a reg
hctrlq	=	$91	;^Q with high bit on
hctrls	=	$93	;^S "
cr	=	$d	;^M carrage rtn
ctrlq	=	$11	;[59] ^Q
ctrls	=	$13	;[59] ^S
dirq	=	$3fe	; interupt address
sscstp	=	$5f8	; +slot,bit 7 on turns off commands to ssc
comnd	=	1	; command to start with
prntax	=	$f941	; print hex bytes in a & x
prbyte	=	$fdda	; print hex byte in a
herld	nasc	<//GS SERIAL PORT V1.6> 1	;[1.1]tell who we are
bad	nasc	<*****ERROR***** COM ROUTINES ASSEMBLED TOO LOW IN MEMORY> 1
statms	nasc	<<- STATUS ERROR ON COM CALL FROM - > 1
temp	.byte		;[1.1] index to init array
binita	.byte	comnd,'F,' ,'D		;[1.1] disable keyboard
	.byte	comnd,'0,'D		;[1.1] 8 data bits 1 stop bit
	.byte	comnd,'0,'P		;[1.1] no parity
	.byte	comnd,'B,'E		;[1.1] enable buffering
	.byte	comnd,'C,'D		;[1.1] disable line feed after cr
;[1.5]	.byte	comnd,'X,'D		;[1.1] disable xon/xoff
	.byte	comnd,'L,'D		;[1.1] disable auto line feed
	.byte	comnd,'E,'D		;[1.1] disable echo to screen
	.byte	comnd,'M,'D		;[1.1] disable mask line feed
	.byte	comnd,'A,'D		;[1.1] disable basic tabs
	.byte	comnd,'Z,0		;[1.1] the last in the list
bbrka	.byte	comnd,'T		;[1.1] go to terminal mode
	.byte	comnd,'S		;[1.1] now for the break
	.byte	comnd,'Q		;[1.1] now exit terminal mode
	.byte	comnd,'Z,0		;[1.1] last of the list
saveac	.byte		; next input ch
gmb	.byte	3	; # parameters
gmbc	.byte	0	; command 0=read 1=write $14=flush-in $15=flush-out
gmbr	.word		; result
gmbd	.byte		; 7-0 bit image
	.byte		; 15-8
gmbz	.byte		; 23-16
	.byte		; 31-24

;
;	Apple //gs  serial interface support
;

prerst	cpx	#0		; first see if there is an error
	beq	prersa		; no
;[1.4]	jsr	prbyte		;
preree				;[1.4]
	jsr	prntax		;[1.4]
	ldx	#statms\	; tell what we got
	ldy	#statms^
	jsr	prstr	
	pla			; get low byte of call address
	tax
	pla			; and the high byte
	tay
	pha
	txa
	pha			; now it back correct
	tya			; put the high byte in a
	jsr	prntax		; and print them
	jmp	prcrlf		; on a line by itself, & let prcrlf do the rts
prersa	rts
alowcm
	sei			; lock out interupts
	lda	#3		; 3 for param count
	sta	gmb
	lda	#0
	sta	gmbc		; make the command get
	jsr	dmb		; send the request
	lda	gmbz		; get the command ignore byte
	and	#$7f		; make the bit 0
	sta	gmbz		; and set it in the list
	lda	gmbd		; now turn off dtr/dsr
;[1.4]	and	#$fb
	ora	#4		;[1.4] turn on dtr/dsr handshake
	and	#$df		;[1.5] turn off xon/xoff handshake
	bit	flowfg		;[1.5] see if we should xon/xoff
	bpl	alow3		;[1.5] no
	ora	#$20		;[1.5] tell firmware abt xon/xoff
	and	#$fb		;[1.5] turn off dtr
alow3				;[1.5]
	sta	gmbd
	lda	#1		; make the command set
	sta	gmbc
	jsr	dmb
	cli			; now allow interupts
	rts
;[1.1]flush
;[1.1]	sei			; lock out interupts
;[1.1]	lda	#2		; 2 for param count
;[1.1]	sta	gmb
;[1.1]	lda	#$14		; flush input queue
;[1.1]	sta	gmbc
;[1.1]	jsr	dmb		; do it
;[1.1]	lda	#$15		; flush output queue
;[1.1]	sta	gmbc
;[1.1]	jsr	dmb	
;[1.1]	cli			; now allow interupts
;[1.1]	rts			; thats all folks
dmb	
	.byte	$8b		; should be PHB (push bank on stack)
	ply			; and put it in y
	ldx	#gmb^		; middle of the 3 bytes of address
	lda	#gmb\		; and low
cnsta5	jsr	$c000		; call the extended interface
	.ifne	debug	;[1.4] conditional assembly
; till apple fixes the bug	bcc	dmbr		;[1.4] was it good, yes
	lda	gmbr+1		;[1.4] see if we have an error
	ora	gmbr		;[1.4]
	beq	dmbr		;[1.4] nope
	lda	gmbr+1		;[1.4] should be something here
	ldx	gmbr		;[1.4] ***** debug hope this is the right byte
	jmp	preree		;[1.4] tattle and let it do the rts
	.endc		;[1.4]
dmbr	rts

tl2int:
	lda	#start^
	cmp	endker+1	;are we loaded above main
	beq	dontno		;cant tell yet
	bcc	trble		;yes we are in trouble
	bcs	setnm		;ok 
dontno	lda	#start\		;well lets check 16 bits
	cmp	endker
	beq	setnm		;whee just exactly right
	bcs	setnm		;ok
trble	ldx	#bad\		;got to tell someone
	ldy	#bad^
	jsr	prstr		;print the message
	jsr	prcrlf		;and terminate it properly
setnm:
	lda	kerins
	bne	prersa		; already initialized
	lda	kersli		; first generate the $cn
	lsr	a		;
	lsr	a		;
	lsr	a		;
	lsr	a		;
	ora	#$c0		; finally $cn
	sta	cnstat+2	; this sets up the high byte to $cn
	sta	cnsta1+2	;
	sta	cnsta2+2	;
	sta	cnsta3+2	;
	sta	cnsta4+2	;
	sta	tl2cp1+2	;
	sta	tl2gc1+2	;
	sta	tl2pc1+2	;
	sta	tl2pc2+2	;
	sta	cnsta5+2
	sta	cnsta0+2
cnsta0	lda	$c012		; the extended offset
	sta	cnsta5+1	; now the jsr should all be correct
	jsr	alowcm		; allow commands
cnstat	lda	$c00d		; get the init offset from $cn0d
	sta	cnsta1+1	; now set the low byte address
	ldy	kersli		; y=$n0
	ldx	cnsta1+2	; x=$cn
cnsta1	jsr	$c000		; init
	jsr	prerst		; check for errors
cnsta2	lda	$c00e		; get the read offset
	sta	tl2gc1+1	; and set up the get ch call
cnsta3	lda	$c00f		; get the write offset
	sta	tl2pc1+1	; and set up the put ch call
cnsta4	lda	$c010		; get the status offset
	sta	tl2cp1+1	; and set up the read status call
	sta	tl2pc2+1	; and set up the write status call
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'F		;  no keyboard
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#' 
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'D
;[1.1]	jsr	finis
	lda	#comnd		; start of the command string
	jsr	tl2ppf		; send it
	lda	sscdbd		; first the baud
	cmp	#9		; hex and dec 
	bcc	tl2inz
	pha			; going to need this
	lda	#'1		; power of 10 sigh
	jsr	tl2ppf
	pla
	sec			; now take away the 10
	sbc	#10
tl2inz	clc			; make it ascii
	adc	#$30		; that should do it
	jsr	tl2ppf
	lda	#'B		; that says baud
;[1.1]	jsr	finis
	jsr	tl2ppf		;[1.1] dont send cr
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'0		; 8 data bits 1 stop bit
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'D
;[1.1]	jsr	finis
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'0		; how about no parity
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'P
;[1.1]	jsr	finis
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'B		; enable buffering
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'E
;[1.1]	jsr	finis
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'C		; disable line formating
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'D
;[1.1]	jsr	finis
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'X		; disable xon xoff
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'D
;[1.1]	jsr	finis
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'L		; disable auto line feed
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'D
;[1.1]	jsr	finis
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'E		; disable echo to screen
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'D
;[1.1]	jsr	finis
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'M		; disable mask line feed
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'D
;[1.1]	jsr	finis
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'A		; disable basic tabs
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'D
;[1.1]	jsr	finis
;[1.1]	jsr	flush		; now that baud is set flush previous
;[1.1]	lda	#comnd
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'Z		; no more commands, accept all chs
;[1.1]	jsr	finis
	stz	temp		;[1.1] starting index
tl2iny	ldx	temp		;[1.1]
	lda	binita,x	;[1.1] get initialization ch
	beq	tl2inx		;[1.1] are we thru? yes
	jsr	tl2ppf		;[1.1] no send the ch
	inc	temp		;[1.1] ready for next
	jmp	tl2iny		;[1.1]
tl2inx				;[1.1] thats all
	lda	#true
	rts			; say its ok
;[1.1]finis	jsr	tl2ppf		; send a out
;[1.1]	lda	#cr		; and terminate the command
;[1.1]	jmp	tl2ppf		; let tl2ppc do the rtn also

tl2cp:	ldx	tl2cp1+2	; x needs $cn
	ldy	kersli		; y needs $n0
	lda	#1		; input ready?
tl2cp1	jsr	$c000		; status call
	bcs	tl2cp5		; *********** debug
	jsr	prerst		; *********** debug
tl2cp2	lda	#false		; ready for no
	rts
tl2cp5	ldx	tl2gc1+2	; x needs $cn
	ldy	kersli		; y needs $n0
tl2gc1	jsr	$c000		; get a ch, tl2cp said we had one
	jsr	prerst		; check for error, let prerst do the rts
	sta	saveac		; save the a for tl2gpc
	ldy	flowfg	;[57] are we flow controll
	bpl	tl2cp6	;[57] no dont worry about stopping output
	and	#$7f	;[59] ignore parity
	cmp	#ctrlq	;[59] do we have a continue
	bne	tl2in2	;[59] no
	lda	#$bf	;[59] yes, now turn on flow
	and	flowfg	;[59]
	sta 	flowfg	;[59]
	jmp	tl2cp2	;[59] and carry on
tl2in2	cmp	#ctrls	;[59] do we have a stop?
	bne	tl2cp6	;[59]
	lda	#$40	;[59] yes tell all
	ora	flowfg	;[59] would you believe the remote
	sta	flowfg	;[59] has asked us to stop!
	jmp	tl2cp2	; return false
tl2cp6	lda	#true		; hooray we have one ready
tl2cp3	rts			;return with false(0) or true(non 0)

tl2gpc:	lda	saveac		
	rts			
tl2ppc:	pha			; Hold the byte to send
tl2pc0	bit	flowfg		; is output on hold?
	bvc	tl2pcl		; no
	jsr	tl2cp		; yes wait for ^q
	jmp	tl2pc0		; throw away everything else
tl2pcl	ldx	tl2pc2+2	; x needs $cn
	ldy	kersli		; y needs $n0
	lda	#0		; ask about outputing a ch
tl2pc2	jsr	$c000		; status call
	bcs	tl2pc7		; *********** debug
	jsr	prerst		; *********** debug
	jmp	tl2pcl		; ready?,no try again
tl2pc7	pla			; get the ch back
tl2ppf	ldx	tl2pc1+2	; $cn again
	ldy	kersli		; $n0 again
tl2pc1	jsr	$c000		; put the ch
	jmp	prerst		; let prerst do the rts

tl2exi:
	lda	#0	;tell we did this
	sta	kerins		;just in case init gets called
	lda	#true		; say its ok
exit9:	rts

tl2drp				;[1.4]
	sei			;[1.4] lock out interupts
	lda	#3		;[1.4] 3 for param count
	sta	gmb		;[1.4]
	lda	#$a		;[1.4] get dtr stuff
	sta	gmbc		;[1.4] make the command get
	jsr	dmb		;[1.4] send the request
	lda	gmbd		;[1.4] now turn off dtr/dsr
	ora	#$80		;[1.4]
	sta	gmbd		;[1.4]
	lda	#$b		;[1.4] set dtr
	sta	gmbc		;[1.4]
	jsr	dmb		;[1.4]
	cli			;[1.4] now allow interupts
	lda	#true		;[1.4] hope hope
	rts			;[1.4]
tl2cmd:			;find out what command
;[1.4]	beq	tl2rts	;its drop line and we cant
	beq	tl2drp	;[1.4] its drop line and we shall see
	cmp	#$0c
	beq	break	;its a break command
	cmp	#$0b
	beq	baud   	;its a set baud command
	cmp	#hctrlq
	beq	tl2sac	;its a xon command
	cmp	#hctrls
	beq	tl2sac	;its a xoff command
tl2fls:	lda	#false	;unknown command
tl2rts:	rts		;que passo ? return false(0)
tl2sac:
	and	#$7f	;drop high bit and send the ch
	jsr	telspa	;set parity
	jsr	tl2ppc	;output the ch
	lda	#1	;set true return
	rts
baud:	lda	#0	; force an initialization
	sta	kerins	; that will reset baud
	lda	#true		;
	rts		;return 
break:
	jsr	alowcm		; allow commands again
;[1.1]	lda	#comnd		; start of command string
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'T		; terminal mode
;[1.1]	jsr	finis
;[1.1]	lda	#comnd		; start of command string
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'S		; break
;[1.1]	jsr	finis
;[1.1]	lda	#comnd		; start of command string
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'Q		; exit terminal mode
;[1.1]	jsr	finis
;[1.1]	lda	#comnd		; start of command string
;[1.1]	jsr	tl2ppf
;[1.1]	lda	#'Z		; now shut off looking
;[1.1]	jsr	finis
	stz	temp		;[1.1]
break2	ldx	temp		;[1.1] index into break array
	lda	bbrka,x		;[1.1] next ch
	beq	break5		;[1.1] are we thru? yes
	jsr	tl2ppf		;[1.1] no send the ch to rom
	inc	temp		;[1.1] ready for next
	jmp	break2		;[1.1]
break5				;[1.1] thats all	
	lda	#true		; and tell we did it ok
	rts
endcom			;[1.3]