**
** ProNET-Driver `internal-parallel'
**
** 07-05-95	Started
** 29-05-95	bset -> or  etc..
** 31-05-95	machine priority system :-(
** 05-06-95	init: flags argument

; Format of one packet is:
; 2bytes LENGTH of data including next two words in WORDS-1 !!!!!
; 2bytes Destination port
; 2bytes Source port
; xbytes DATA

DISABLEINTS	macro
		move.w	#$4000,$dff09a
		endm
ENABLEINTS	macro
		move.w	#$c000,$dff09a
		endm

		include	"A:OSmacros.i"
		include	"exec/exec.i"
		include	"resources/misc.i"
		include	"hardware/cia.i"
		include	"a:ProNET/include/devices/pronet.i"
		include	"exec_lib.i"
		include	"intuition_lib.i"
		include	"dos_lib.i"

; -- Initialization routine
Init		; a0 *DriverData
		; a1 *ConfigString after driver ID
		; d0 "RST!" for Identification
		; d1 Flags
		; RETURNS d0 <>0 if everything OK, else NULL!
		movem.l	d2-d7/a2-a6,-(sp)
		move.l	a0,a4
		move.l	a1,a5
		cmp.l	#"RST!",d0		;compare ID
		bne	.error
		tst.l	d1
		bne	.error			;unknown Flags!

		bsr	AllocPPort
		tst.w	d0
		bne	.error

		move.l	a5,a0
		bsr	dec2slong
		move.w	d1,MACHINE
		bsr	dec2slong
		move.w	d1,PRIORITY

		bsr	InitTransfer
		bsr	TrapOpenDevice

		move.l	4.w,a6
		move.l	ThisTask(a6),a1
		move.w	PRIORITY(pc),d0
		LIBCALL	SetTaskPri

		move.b	INTsigbit(pc),(a4)	;Read Signalbit
		move.l	#ReadQuery,2(a4)
		move.l	#Read,6(a4)
		move.l	#Write,10(a4)
		moveq	#-1,d0
		bra.s	.ende

.error		moveq	#0,d0
.ende		movem.l	(sp)+,d2-d7/a2-a6
		rts

		dc.b	"$VER: pronet-driver `internal-parallel' (05-06-95)",13,10,0
		even

PRIORITY	dc.w	0
MACHINE		dc.w	0

dec2slong	; konvertiert Dezimalstring ab (a0) zu Longword in D1 !!
		; SIGNED!
		moveq	#0,d1
		moveq	#0,d3
		move.b	(a0),d0
		cmp.b	#"-",d0
		bne.s	.loop
		addq.l	#1,a0
		st	d3
.loop		moveq	#0,d0
		move.b	(a0)+,d0
		sub.b	#"0",d0
		cmp.b	#9,d0
		bhi.s	.oki
		move.l	d1,d2
		lsl.l	#3,d1
		add.l	d2,d1
		add.l	d2,d1
		add.l	d0,d1
		bra.s	.loop
.oki		tst.w	d3
		beq.s	.ende
		neg.l	d1
.ende		rts

; -- Read Query routine
ReadQuery	; RETURNS d0 length of pure data to come or NULL
		;         d1 destport
		;         d2 sourceport
		movem.l	d3-d7/a2-a6,-(sp)
		lea	$bfd000,a2	; test if packet is pending
		btst	#0,(a2)
		bne.s	.error
		lea	$bfd200,a3	; ciab ddra
		bset	#1,(a3)		; set ack line to output
		lea	buffer-2(pc),a4	; first word is `empty'
		moveq	#3,d4		; (due to handshake init)
		bsr	ReceiveData
		movem.w	buffer(pc),d0-d2
		subq.w	#2-1,d0
		add.w	d0,d0
		movem.l	(sp)+,d3-d7/a2-a6
		rts
.error		moveq	#0,d0
		movem.l	(sp)+,d3-d7/a2-a6
		rts

; -- Read routine
Read		; a0 *destination
		movem.l	d2-d7/a2-a6,-(sp)
		move.l	a0,a4
		move.w	buffer(pc),d4
		subq.w	#2,d4
		bsr	ReceiveData
		lea	$bfd200,a3	; ciab ddra
		bclr	#1,(a3)		; set ack line to input
		movem.l	(sp)+,d2-d7/a2-a6
		rts


; -- Write routine
Write		; a0 *data1
		; d0.l datalength1 (even)
		; a1 *data2
		; d1.l datalength2 (even)
		; d2 Destination Port
		; d3 Source Port
		; d0+d1 <= $4000
		; d1=0 --> only first chunk is sent, else second is appended
		;          to first one and sent as one chunk!
		; RETURNS d0 <>0 on error, else NULL
		movem.l	d2-d7/a2-a6,-(sp)

		lea	buffer(pc),a5
		movem.l	d0/d1/a0/a1,6(a5)

		move.w	d2,(a5)
		move.w	d3,2(a5)

		move.w	d0,d4
		add.w	d1,d4
		lsr.w	#1,d4
		addq.w	#2-1,d4
		bsr	AcquireLine
		tst.w	d0			;Line is busy now! Try later
		bne.s	.ende

		move.l	a5,a4
		moveq	#1,d4
		moveq	#0,d6
		bsr	SendData

		move.l	14(a5),a4
		move.l	6(a5),d4
		lsr.w	#1,d4
		subq.w	#1,d4
		tst.w	12(a5)
		beq.s	.0

		bsr	SendData

		move.l	18(a5),a4
		move.l	10(a5),d4
		lsr.w	#1,d4
		subq.w	#1,d4

.0		subq.w	#1,d4
		bmi.s	.lastone
		bsr	SendData

.lastone	DISABLEINTS		* We don't take too long here
		moveq	#0,d4		* in case the other machine wants
		bsr	SendData	* to send something...

		lea	$bfd200,a3
		and.b	#%11111000,(a3)	; all control lines input
		lea	$bfe301,a1
		sf	(a1)		; data lines input, too
		lea	$bfd000,a2	; ciab pra   ==> CONTROL LINES
		or.b	#%00000111,(a2)
		ENABLEINTS

		moveq	#0,d0
.ende		movem.l	(sp)+,d2-d7/a2-a6
		rts

		dc.w	0
buffer		dc.w	0,0,0
		dc.l	0,0,0,0

** -----------------------------------------------------------------------
**
**
**
**

**
** Parallel.device trapping
**

**
**
**
**
** -----------------------------------------------------------------------

TrapOpenDevice	move.l	4.w,a6
		move.l	a6,a1
		move.l	#_LVOOpenDevice,a0
		move.l	#.trap,d0
		LIBCALL	SetFunction
		move.l	d0,orgopendev
		rts
.trap		movem.l	a0/a1/d0/d1,-(sp)
		lea	parname(pc),a1
		bsr	CompareStrings
		tst.w	d0
		bne.s	.openit
		movem.l	(sp)+,a0/a1/d0/d1
		move.b	#-1,IO_ERROR(a1)
		moveq	#-1,d0			;IOERR_OPENFAIL
		rts
.openit		movem.l	(sp)+,a0/a1/d0/d1
		move.l	a2,-(sp)
		move.l	orgopendev(pc),a2
		jsr	(a2)
		move.l	(sp)+,a2
		rts
orgopendev	dc.l	0

; -- Compare two null-terminated strings. Case-insensitive
CompareStrings	; a0 *String1
		; a1 *String2
		; RETURNS d0 = 0 --> Strings equal
		move.l	d2,-(sp)
		moveq	#-1,d0
.loop		move.b	(a0)+,d1
		move.b	(a1)+,d2
		bclr	#5,d1
		bclr	#5,d2
		cmp.b	d1,d2
		bne.s	.ende
		tst.b	d1
		bne.s	.loop
		moveq	#0,d0
.ende		move.l	(sp)+,d2
		rts

parname		dc.b	"parallel.device",0

** -----------------------------------------------------------------------
**
**
**
**

**
** Built-in Parallel Port Transfer routines
**

**
**
**
**
** -----------------------------------------------------------------------

; -- Allocate Parallel Port Registers
AllocPPort	lea	miscname(pc),a1
		move.l	4.w,a6
		LIBCALL	OpenResource
		move.l	d0,a6
		move.l	#MR_PARALLELPORT,d0
		lea	INTname(pc),a1
		jsr	-6(a6)			;AllocMiscResource
		tst.w	d0
		bne.s	.err1
		move.l	#MR_PARALLELBITS,d0
		lea	INTname(pc),a1
		jsr	-6(a6)
		tst.w	d0
		bne.s	.err2
		moveq	#0,d0
		rts
.err2		move.l	#MR_PARALLELPORT,d0
		jsr	-12(a6)			;FreeMiscResource
.err1		move.l	4.w,a6
		moveq	#-1,d0
		rts
miscname	dc.b	"misc.resource",0
ciaaname	dc.b	"ciaa.resource",0
		even
ciaabase	dc.l	0

; -- Init Transfer routines
InitTransfer	movem.l	d7/a2/a3/a6,-(sp)

		move.l	4.w,a6
		move.l	ThisTask(a6),INTsigtask

		moveq	#-1,d0
		LIBCALL	AllocSignal
		move.b	d0,INTsigbit

		bsr	InitParallel

		lea	ciaaname(pc),a1
		move.l	4.w,a6
		LIBCALL	OpenResource
		move.l	d0,a6
		move.l	d0,ciaabase
		moveq	#CIAICRB_FLG,d0
		lea	INTstruct(pc),a1
		jsr	-6(a6)

		movem.l	(sp)+,d7/a2/a3/a6
		rts

INTsigtask	dc.l	0
INTsigbit	dc.w	0

INTstruct	dc.l	0,0
		dc.b	2,127
		dc.l	INTname
		dc.l	0,INTcode
INTname		dc.b	"ProNET Internal-Parallel Driver",0
		even
INTcode		lea	$bfd000,a0		;check if the interrupt
		btst	#0,(a0)			;was `correct' or caused
		bne.s	.no			;by switching on the remote
		move.l	4.w,a6			;machine
		move.l	INTsigtask(pc),a1
		move.b	INTsigbit(pc),d1
		moveq	#0,d0
		bset	d1,d0
		LIBCALL	Signal
.no		moveq	#1,d0
		rts

;:---------------------------------------------------------------------------
;:-- InitParallel
InitParallel
		lea	$bfe101,a0	; ciaa prb   ==> DATA LINES
		lea	$bfe301,a1	; ciaa ddrb
		lea	$bfd000,a2	; ciab pra   ==> CONTROL LINES
		lea	$bfd200,a3	; ciab ddra

		and.b	#%11111000,(a3)	; all control lines input  ---|
		sf	(a1)		; [[data lines input, too]]   v
		or.b	#%00000111,(a2)	; and 1 when we set them to output
		rts

;:---------------------------------------------------------------------------
;:-- AcquireLine
;:-- d4 Number of words-1 that will be sent !
;:-- !!!!!! RETURNS d0=0  if no error
;:--                d0<>0 if line was busy
AcquireLine
		lea	$bfd000,a2	; ciab pra   ==> CONTROL LINES
		lea	$bfd200,a3	; ciab ddra

		DISABLEINTS
		btst	#0,(a2)
		bne.s	.free
		ENABLEINTS
		moveq	#-1,d0
		rts

.free		bset	#0,(a3)
		bclr	#0,(a2)

		bset	#2,(a3)		; cause interrupt by quickly toggling
		bclr	#2,(a2)		; the FLAG input of the other
		bset	#2,(a2)		; machine
		bclr	#2,(a3)

		move.l	ciaabase(pc),a6	; reset interrupt flag which was
		moveq	#CIAICRF_FLG,d0	; set on our machine, too
		jsr	-24(a6)		; (SEL&ACK connected at parallel port)

		ENABLEINTS

		lea	$bfe101,a0	; ciaa prb   ==> DATA LINES
		lea	$bfe301,a1	; ciaa ddrb

		tst.w	firstpacketflag	; no timeout for the first packet!
		beq.s	.acknotimeout
		tst.w	MACHINE		; no timeout for machine 1!
		bne.s	.acknotimeout

		move.l	#100000,d0
.ack0		btst	#1,(a2)		; wait for it to respond...
		beq.s	.ack0ok
		subq.l	#1,d0
		bne.s	.ack0

		bset	#0,(a2)
		and.b	#%11111000,(a3)	; TIMEOUT! reset all lines
		or.b	#%00000111,(a2)
		bsr	INTcode
		moveq	#-1,d0
		rts

.acknotimeout	btst	#1,(a2)
		bne.s	.acknotimeout

.ack0ok		st	firstpacketflag
		bset	#0,(a2)		; and initialize handshake sequence
.ack1		btst	#1,(a2)
		beq.s	.ack1

		st	(a1)		; set data lines to output now
		ror.w	#8,d4		; and hand the length word over
		move.b	d4,(a0)		; to the remote machine
		bclr	#0,(a2)
		ror.w	#8,d4
.ack2		btst	#1,(a2)
		bne.s	.ack2
		move.b	d4,(a0)
		bset	#0,(a2)
.ack3		btst	#1,(a2)
		beq.s	.ack3
		moveq	#0,d0
		rts

firstpacketflag	dc.w	0

;:---------------------------------------------------------------------------
;:-- SendData
;:-- a4 *data
;:-- d4 datalength in words-1
SendData
		lea	$bfe101,a0	; ciaa prb   ==> DATA LINES
		lea	$bfd000,a2	; ciab pra   ==> CONTROL LINES

		move.b	#%11111110,d0
		move.b	#%00000001,d1

.loop		move.b	(a4)+,(a0)	; fully handshaked data txfer
		and.b	d0,(a2)
.ack0		btst	#1,(a2)
		bne.s	.ack0
		move.b	(a4)+,(a0)
		or.b	d1,(a2)
.ack1		btst	#1,(a2)
		beq.s	.ack1
		dbra	d4,.loop
		rts

;:---------------------------------------------------------------------------
;:-- ReceiveData
;:-- a4 *datadest
;:-- d4 datalength in words-1
ReceiveData
		lea	$bfe101,a0	; ciaa prb   ==> DATA LINES
		lea	$bfd000,a2	; ciab pra   ==> CONTROL LINES

		move.b	#%11111101,d0
		move.b	#%00000010,d1

.loop		btst	#0,(a2)
		bne.s	.loop
		move.b	(a0),(a4)+
		and.b	d0,(a2)
.ack0		btst	#0,(a2)
		beq.s	.ack0
		move.b	(a0),(a4)+
		or.b	d1,(a2)
		dbra	d4,.loop
		rts