.lif  z %defin
	.title	Performance analysis package
	.sbttl	Performance analysis package: 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 <PERFORMANCE>,cxperformance

.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

  dsect <
$paddr::	.blkw 1		;address of machine to perform on
$ptim1::	.blkw 2		;start time
$ptim2::	.blkw 2		;end time
$ppkts::	.blkw 2		;packet count
  >,l$perf

cxperformance:
	cx$srv 100$,40,40_8,<>	;start address, stack size, priority, no code

100$:
	mov r0,r3
	clr r4			;no data connection
	clr r5			;no packet
	call cpkpki
	if cs,<
110$:	  mov r3,r0
	  call ccnfre
	  mov r4,r0
	  if ne,<call ccnfre>
	  mov r5,r1
	  if ne,<call cpkfre>
	  .logout
	  >
	call 200$		;scan for start of next token
	if eq,<
140$:	  mov (pc)+,r2
	    .string <Usage is: PERFORMANCE {S or E} from_addr to_addr>
	  clr $cpknb(r1)
	  call cpkaz1
	  movb #%cocls,$cpkop(r1)
	  call cpkpko
	  br 110$
	  >	
	call 300$		;get command into r2
	 beq 140$
	call 200$		;scan for next token
	 beq 140$
	call 310$		;extract octal number into r5
	 beq 140$
.wscalar prfadf
	mov r5,prfadf		;from address
	clr r5			;clear reg
	call 200$		;scan for next token
	 beq 140$
	call 310$		;get octal number
	 beq 140$
.wscalar prfadt			;to address
	mov r5,prfadt
	clr r5			;clear reg
	mov #3,$cpkpn(r1)	;set window size
	movb #%coopn,$cpkop(r1)
	call cpkpko
	call ccnall
	beq 110$
	mov r0,r4
	mov prfadf,$cclad(r0)	;from address
	mov #$cpkdt+4,r1
	call cpkall
	beq 110$
	movb #%corfc,$cpkop(r1)	;RFC
	mov prfadt,$cpkda(r1)		;to the to-address
	mov #8,$cpkpn(r1)	;set window size
	clr $cpknb(r1)
	call cpkaz1
	call cpkpko
	bcs 110$
	push #%csrfs
	.regs #hng.ne,sp,r4
	add #$ccsta,r2
	.hang
	pop *

	push #-1		;hang variable
	mov sp,$ccepr(r3)
	mov sp,$ccepr(r4)
	mov sp,$ccepx(r4)
	mov sp,$ccebr(r3)	;it's non-zero!!
	mov sp,$ccebr(r4)
	mov sp,$ccebx(r4)
	loop <
	  tst (sp)
	  if eq,<
	    .regs #hng.ne,sp,#zero
	    .hang
	    >
	  clr (sp)
	  mov r3,r0		;check control connection
	  call cpkpki
120$:	  bcs 110$
	  if ne,<
	    call cpkfre		;free the packet
	    inc (sp)
	    >
	  mov r4,r0
	  call cpkpki
	  bcs 120$
	  if ne,<
	    tst r5
	    if eq,<mov r1,r5>
	    else  <call cpkfre>
	    inc (sp)
	    >
	  call cpkxok
	  blt 120$
	  if gt,<
	    mov r5,r1
	    if eq,<
	      loop <
	        mov #$cpkdt+488.,r1
	        call cpkall
		exitl ne
		push fsmfrc
		.regs #hng.ne,sp,#fsmfrc
		.hang
		pop *
		rptl
	      > >
	    clr r5
	    mov r4,r0
	    mov #488.,$cpknb(r1)
	    call cpkdto
	    inc (sp)
	    >
	  rptl
	  >
	

200$:	push r5,r4
	mov $pktbc(r1),r5
	if ne,<
	  mov $pktbp(r1),r4
	  loop <
	    cmpb (r4),#40
	    exitl eq
	    inc r4
	    sorl r5
	    br 210$
	    >
	  loop <
	    cmpb (r4),#40
	    exitl ne
	    inc r4
	    sorl r5
	    >
	  >
210$:	mov r4,$pktbp(r1)
	mov r5,$pktbc(r1)
	pop r4,r5
	tst $pktbc(r1)		;test for zeroness
	return

300$:	loop <
	  movb @$pktbp(r1),r2
	  cmpb r2,#'S
	  if eq,<
	    mov (pc)+,r2
	      .string <SINK>
	    exitl
	    >
	  cmpb r2,#'E
	  if eq,<
	    mov (pc)+,r2
	      .string <ECHO>
	    exitl
	    >
	  clr r2
	  >
	tst r2
	return

310$:	push r2,r3,r4
	clr r5
	mov $pktbc(r1),r2
	if ne,<
	  mov $pktbp(r1),r3
	  loop <
	    movb (r3),r4
	    cmpb r4,#'0
	    if ge,<
	      cmpb r4,#'7
	      if le,<
	        sub #'0,r4
		ash #3,r5
		add r4,r5
		inc r3
		sorl r2
	  > > > >
	mov r3,$pktbp(r1)
	mov r2,$pktbc(r1)
	pop r4,r3,r2
	tst r5
	return


prfini:	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: