.lif  z %defin
	.title	DOVER server (CHAOS/PUP)
	.sbttl	DOVER server (CHAOS/PUP) support: Definitions, Macros and Code

.iif  z %defin, .nlist		;don't list definitions and macros if not
				;defining them

.if  nz %defin			;only define symbols when we are supposed to

.if p1
	.sbttl	-- Definitions 


.endc p1

****
	.sbttl	-- Macros
****

chnsrv <DOVER>,cxdover		;define the dover server

.endc %defin

.iif  z %defin, .list		;start listing again

.iif nz %defin, .nlist		;don't list code if only doing definitions

.if   z %defin			;only do code if not defining symbols

	.sbttl	-- Code

.wscalar dvvava			;only one connection allowed at a time
.wscalar dvvwrk			;work variable
	
cxdover:
	cx$srv 100$,40,140_8,<>	;start address, stack size, priority, no code

100$:	call cpkpki		;get the RFC
	if cs,<
110$:	  call ccnfre
	  .logout
	  >
	tst dvvava
	if eq,<			;nope
	  mov (pc)+,r2		;in use message
	    .string <BUSY>	;people may depend on this
	  clr $cpknb(r1)
	  call cpkaz1
	  movb #%cocls,$cpkop(r1)
	  call cpkpko
	  br 110$
	  >
	clr dvvava		;sieze the dover

	mov #dvvwrk,$ccepr(r0)	;event pointer receive
	mov #-1,$ccebr(r0)	;event bits    receive
	mov #6,$cpkpn(r1)	;window size (parameterize someday)
	movb #%coopn,$cpkop(r1)	;open the connection
	call cpkpko
	mov r0,r5
	clr r3			;no current chaos packet

	call ppcall		;allocate a pup connection
	mov r0,r4		;save it away
	if eq,<
200$:				;also general exit mechanism
	  mov r3,r1
	  if ne,<call cpkfre>
	  mov r4,r0
	  if ne,<call ppcfre>
	  br 110$
	  >
	mov #dvcadr,$pcfad(r0)	;foreign address
	mov #20,$pcfid(r0)	;foreign socket

	mov #-1,dvvwrk		;declare work to do
	loop <
	  tst dvvwrk		;anything to do?
	  if eq,<		;nope, wait it out
	    .regs #hng.ne,#dvvwrk,#zero
	    .hang
	    rptl
	    >
	  clr dvvwrk
	  mov r4,r0		;get pup connection object
	  call ppkxok		;ok to transmit pup?
	    bcs 200$		;  pup connection disappeared
	  if ne,<		;OK
	    mov r3,r1		;get previous chaos packet
	    if eq,<
	      mov r5,r0		;get chaos connection object
	      call cpkpki	;get a chaos packet
		bcs 200$	;  chaos connection disappeared
	      rptl eq		;none there, go wait
	      >
	    call dvrctp		;dover:chaos-to-pup
	      bcs 200$		;  closing-type-packet
	    call ppkpko		;send out the new pup packet
	    inc dvvwrk		;still may be more work to do
	    >
	  rptl
	  >

dvrctp:	tstb $cpkop(r1)
	if pl,<			;not data
	  cmpb $cpkop(r1),#%coeof	;might be EOF
	  if ne,<		;nope something else.  close things down
	    call cpkfre		;free the packet
	    sec			;declare error
	    return
	  > >
	call cpks16		;make the data safe for 16.bit data
	mov r1,r3
	mov $cpknb(r3),r1	;get number of chaos data bytes
	add #$ppkdt+2,r1	;header plus checksum
	push r1
	loop <
	  call ppkall		;get a pup packet
	  if eq,<
	    call fsmhng		;wait for memory to clear up
	    rptl		;try again
	  > >
	mov #%pkt16,$pktfl(r1)	;safe for 16.bit
	pop $ppksz(r1)		;set the size
	tstb $cpkop(r3)		;data or EOF
	if pl,<mov #32,$ppkty(r1)>	;set pup type to 32
	else  <mov #30,$ppkty(r1)>	;else to 30
	mov $cpknb(r3),r2	;get number of bytes
	inc r2
	asr r2
	if ne,<
	  push r1,r3
	  add #$ppkdt,r1
	  add #$cpkdt,r3
	  loop <
	    mov (r3)+,(r1)+
	    sorl r2
	    >
	  pop r3,r1
	  >
	push r1
	mov r3,r1
	clr r3
	call cpkfre		;free the old chaos packet
	pop r1
	clc			;no error
	return

****

.endc %defin

.iif nz %defin, .list		;start listing as usual


;; local modes:
;; mode:midas
;; auto fill mode:
;; fill column:75
;; comment column:32
;; end: