*
* internal-parallel (ProNET driver)
*

; 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	"P:include/devices/pronet.i"
		include	"exec_lib.i"
		include	"intuition_lib.i"
		include	"dos_lib.i"

Init		movem.l	d2-d7/a2-a6,-(sp)
		move.l	a0,a4
		move.l	a1,a5
		cmp.l	#"RST!",d0		;compare ID
		bne	.ende
		cmp.l	#2,d1
		bne.s	.ende

		move.l	#PNDRVERR_WRONG_ARGS,RC
		move.l	a5,a0
		bsr	dec2slong
		tst.w	d4
		bmi.s	.ende
		move.w	d1,MACHINE
		bsr	dec2slong
		tst.w	d4
		bmi.s	.ende
		move.w	d1,PRIORITY

		bsr	TrapOpenDevice

		bsr	AllocPPort
		tst.w	d0
		bne.s	.ende

		bsr	InitTransfer

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

		move.b	INTsigbit(pc),pndd_ReadSignalBit(a4)
		move.l	#ReadQuery,pndd_ReadQuery(a4)
		move.l	#ReadFlush,pndd_ReadFlush(a4)
		move.l	#Read,pndd_Read(a4)
		move.l	#Write,pndd_Write(a4)
		move.l	#Exit,pndd_Exit(a4)

		clr.l	RC

.ende		movem.l	(sp)+,d2-d7/a2-a6
		move.l	RC(pc),d0
		rts

RC		dc.l	0

		dc.b	"$VER: internal-parallel 37.0 (30.11.96)",13,10,0
		even

Exit		movem.l	d2-d7/a2-a6,-(sp)
		bsr	ExitTransfer
		bsr	FreePPort
		bsr	UnTrapOpenDevice
		movem.l	(sp)+,d2-d7/a2-a6
		rts

PRIORITY	dc.w	0
MACHINE		dc.w	0

dec2slong	; konvertiert Dezimalstring ab (a0) zu Longword in D1 !!
		; SIGNED!
		moveq	#-1,d4
		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
		clr.l	d4
		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

ReadQuery	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 POUT (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

ReadFlush
		movem.l	d2-d7/a2-a6,-(sp)
		move.w	buffer(pc),d4
		subq.w	#2,d4
		bsr	FlushData
		bra.s	read_entry

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

Write		movem.l	d2-d7/a2-a6,-(sp)

		lea	buffer(pc),a5
		move.l	a0,6(a5)
		move.l	d0,10(a5)

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

		move.w	d0,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	6(a5),a4	; The last word gets sent separately.
		move.l	10(a5),d4
		lsr.w	#1,d4
		subq.w	#2,d4
		bmi.s	.0
		bsr	SendData

.0		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

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

**
** 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

UnTrapOpenDevice
		move.l	4.w,a6
		move.l	a6,a1
		move.l	#_LVOOpenDevice,a0
		move.l	orgopendev(pc),d0
		LIBCALL	SetFunction
		rts

; -- 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	#err1,RC
		move.l	d0,miscbase
		beq.s	APP_nores

		move.l	d0,a6
		move.l	#MR_PARALLELPORT,d0
		lea	INTname(pc),a1
		jsr	-6(a6)			;AllocMiscResource
		move.l	#err2,RC
		tst.w	d0
		bne.s	APP_noport

		move.l	#MR_PARALLELBITS,d0
		lea	INTname(pc),a1
		jsr	-6(a6)
		move.l	#err3,RC
		tst.w	d0
		bne.s	APP_nobits

		moveq	#0,d0
		rts

FreePPort	move.l	miscbase(pc),a6
		move.l	#MR_PARALLELBITS,d0
		jsr	-12(a6)
APP_nobits	move.l	#MR_PARALLELPORT,d0
		jsr	-12(a6)
APP_noport
APP_nores	moveq	#-1,d0
		rts

miscname	dc.b	"misc.resource",0
ciaaname	dc.b	"ciaa.resource",0
err1		dc.b	"Can't find misc.resource.",0
err2		dc.b	"Can't allocate misc/MR_PARALLELPORT.",0
err3		dc.b	"Can't allocate misc/MR_PARALLELBITS.",0
		even
miscbase	dc.l	0
ciaabase	dc.l	0

; -- Init Transfer routines
InitTransfer	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)

		rts

ExitTransfer	move.l	ciaabase(pc),a6
		moveq	#CIAICRB_FLG,d0
		lea	INTstruct(pc),a1
		jsr	-12(a6)
		move.l	4.w,a6
		move.b	INTsigbit(pc),d0
		LIBCALL	FreeSignal
		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=-1 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

FlushData
		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
		and.b	d0,(a2)
.ack0		btst	#0,(a2)
		beq.s	.ack0
		or.b	d1,(a2)
		dbra	d4,.loop
		rts