.title	NetHdl

	.includ	"b:global"

	sect	code

oSeNtP:	jmp	KOMNYI

.rem	&

	call	pcrlf
10$:	PARSER	#ChDLst, #-1, #CnWr
	call	pcr2lf
	tst	Level
	beq	999$

	mov	Found, r1
	call	GetAdr
	call	@(r1)
	br	10$

999$:	rts	pc

; &

proc	oCSetP

var	Pos,	word
var	AlwH,	word

begin
	push	<r2, r3, r4>

	Repars	#2, #TvN
	bcs	999$

	call	fixlst
	bcs	999$
	
	mov	Found(r0), r1
	call	GetAdr

	mov	(r1), r4
	mov	rArg(r1), r3
	mov	#DstBuf, r2
	mov	(r2)+, r0
	beq	20$
10$:	cmp	r4, (r2)+
	beq	30$
	add	(r2), r2
	sob	r0, 10$

20$:	add	#rStr, r1
	call	strout
	Write	#INAR
	br	999$

30$:	tst	(r2)+
	mov	r2, Pos(r5)

	gos	GetRec,	<#1, r3, #FB3, #Unlock>
	mov	66(r1), AlwH(r5)

50$:	PARSER	#HdrLst, AlwH(r5), #SeT
	call	pcr2lf
	mov	Level, r0
	beq	999$

	mov	Found, r1
	call	GetAdr
	tst	(r1)
	bne	100$

	gos	ListHd,	<Pos(r5),>
	call	pcrlf
	br	50$	

100$:	clr	r2
	clr	r3

	cmp	#1, Level
	beq	150$

	mov	Strs+2, r4
	mov	Strs+4, r3
	sub	r4, r3			; Eg length + 1

150$:	gos	SetPar,	<r1, r4, r3, Pos(r5)>
	br	50$

999$:	pop	<r4, r3, r2>
	ret	

oCList:	push	<r2, r3, r4, r5>
	mov	#DstBuf, r2
	mov	(r2)+, r3
	beq	999$

10$:	clr	out
	mov	(r2)+, r0
	call	PrtNam
	mov	r2, r4
	add	(r2)+, r4
	tst	(r2)
	beq	20$

	Write	#KoSp
	gos	ListHd,	<r2, Out>
	br	30$

20$:	call	pcrlf
30$:	mov	r4, r2
	beq	999$
	sob	r3, 10$

999$:	call	pcrlf
	pop	<r5, r4, r3, r2>
	rts	pc

oCAddM:	Repars	#2, #VVDA
	bcs	999$
	call	FixLst
	bcs	999$
	call	FixGrp			; r1 = NetName, r2 = Group #.
	bcs	999$

	gos	WrToP,	<r2, #FB1, #True>
	bcc	5$

	Write	#DHIR
	br	999$

5$:	mov	#DstBuf, r4
	mov	(r4)+, r0
	beq	20$
10$:	cmp	r2, (r4)+
	beq	200$
	add	(r4), r4
	sob	r0, 10$

20$:	inc	DstBuf			; One more receiver.
	mov	r2, (r4)+
	push	r4
	mov	r4, (r4)		; To be next pointer
	neg	(r4)+
	tst	r1			; Net-name.
	bne	30$

	clr	(r4)+			; No, Net-name!
	br	50$

30$:	mov	#1, (r4)+		; # of headers.
	movb	(r1)+, r0		; Length of name
	movb	r0, (r4)
	incb	(r4)+			; Make room for -
	movb	#'B, (r4)+		;  Header-Type-Letter
40$:	movb	(r1)+, (r4)+
	sob	r0, 40$
	inc	r4
	bic	#1, r4			; Evenize

50$:	add	r4, @(sp)+		; Fix next-poiner.
	mov	r4, EoDPos		; End of buffer.
	br	999$

200$:	tst	r1
	bne	220$

210$:	mov	r2, r0
	call	PrtNam
	write	#IAAR
	br	999$

220$:	movb	(r1), r2		; Length of net-name.
	add	#4, r2			; Extra space for header-type-
	bic	#1, r2			;  letter and a trailing ",".
	add	r2, (r4)+
	inc	(r4)+			; Nr of headers
	movb	#'+, 1(r4)		; We asume 1'st header is a To-
	mov	EoDPos, r3		;  field.
	mov	r3, r0
	add	r3, r2
	mov	r2, EoDPos
	sub	r4, r0
	beq	250$

230$:	movb	-(r3), -(r2)
	sob	r0, 230$

250$:	movb	(r1)+, r0
	movb	r0, (r4)
	incb	(r4)
	incb	(r4)+
	movb	#'B, (r4)+
260$:	movb	(r1)+, (r4)+
	sob	r0, 260$
	movb	#',, (r4)+

999$:	rts	pc

oCSubM:	Repars	#2, #VVDS
	bcs	999$
	call	FixLst
	bcs	999$
	call	FixGrp			; r1 = NetName, r2 = Group #.
	bcs	999$

	mov	#DstBuf, r4
	mov	(r4)+, r0
	beq	20$
10$:	cmp	r2, (r4)+
	beq	200$
	add	(r4), r4
	sob	r0, 10$

20$:	mov	r2, r0			; Receiver not found.
	call	prtnam			; Write an error message

  ; Subtraction of individual receiver-fields are left for the feature...

;	mov	r1, r3			;  and exit...
;	beq	30$
;	write	#KoSp
;	write	r3

30$:	write	#INAR
	br	999$

200$:	mov	r4, r3
	add	(r4), r3
	tst	-(r4)
	mov	EoDPos, r2
	sub	r3, r2
	beq	230$

220$:	movb	(r3)+, (r4)+		; Remove everything with this
	sob	r2, 220$		;   receiver
230$:	mov	r4, EoDPos
	dec	DstBuf			; One receiver less!

999$:	rts	pc

proc	SetPar,	<Cmd, Pos, Len, Buf>

Var	Hdr,	word
Var	AdrP,	word
Var	Nr,	word
Var	Ptr,	word
Var	Nxt,	word

begin
	mov	Buf(r5), Nxt(r5)	; Pointer to header-feild-list.
	sub	#2, Nxt(r5)		; Pointer to next receiver (rel).
	mov	Cmd(r5), r1

	mov	rLinkp(r1), AdrP(r5)	; Address-field?
	mov	(r1), Hdr(r5)		; Prefix for header

30$:	mov	r1, r0
	add	#rStr, r0
	call	MovPro			; Save string!

 ; 1'st move: Remove old seting!

	mov	Buf(r5), r1
	mov	(r1)+, r3
	beq	55$

40$:	movb	(r1)+, r0
	beq	50$
	cmpb	Hdr(r5), (r1)
	beq	60$
50$:	add	r0, r1
	inc	r1
	bic	#1, r1
	sob	r3, 40$
55$:	mov	r1, Ptr(r5)
	br	200$

60$:	mov	r1, r2
	dec	r2
70$:	add	r0, r1
	inc	r1
	bic	#1, r1
80$:	dec	@Buf(r5)
	dec	r3
	beq	100$
	movb	(r1)+, r0
	beq	80$
	cmpb	#'+, (r1)
	beq	70$

	dec	r1

100$:	mov	r2, Ptr(r5)
	sub	r1, @Nxt(r5)
	add	r2, @Nxt(r5)		; sub (r1-r2), @Nxt(r5)
	mov	EoDPos, r0
	sub	r1, r0
	beq	140$

110$:	movb	(r1)+, (r2)+
	sob	r0, 110$

130$:	mov	r2, EoDPos
140$:

; 2'nd move: add new contents.

200$:	clr	Nr(r5)
	mov	Pos(r5), r2
	beq	210$
	mov	Len(r5), r3
	bne	240$
	
210$:	PARSER	#FltLst, #-1, #PrsPro
	call	pcrlf
	tst	level
	bne	220$

	tst	Nr(r5)
	bne	500$
	cmp	#'B, Hdr(r5)
	bne	500$
	Write	#DMET
	br	210$

220$:	mov	Strs+2, r3
	mov	Strs, r2
	sub	r2, r3
	beq	210$

240$:	dec	r3
	beq	210$
	tst	AdrP(r5)
	beq	280$
	mov	r2, r1
	mov	r3, r0

250$:	cmpb	#',, (r1)+
	bne	270$

	mov	r1, r3
	sub	r2, r3
	tst	Nr(r5)
	bne	255$
	dec	r3
255$:	call	$AdPa
	mov	r1, r2
	mov	r0, r3
	dec	r3
	bmi	270$

	cmpb	#40, (r1)		; Space
	beq	260$
	cmpb	#11, (r1)		; Tab
	bne	270$
260$:	inc	r2
	dec	r3

270$:	sob	r0, 250$
	tst	Nr(r5)
	beq	280$
	
	movb	#',, (r1)
	inc	r3	

280$:	call	$AdPa

300$:	br	210$

500$:	call	pcrlf

999$:	ret

$AdPa:	push	<r0, r1, r2, r3, r4>
	inc	r3
	push	r3
	add	#2, r3
	bic	#1, r3
	tst	Nr(r5)
	beq	245$
	mov	Ptr(r5), r1
	movb	#'+, 1(r1)
245$:	add	r3, @Nxt(r5)
	mov	EoDPos, r1		; 1'st free pos in NetBuf.
	mov	r1, r0
	mov	r1, r4
 	add	r3, r4
	mov	r4, EoDPos
	sub	Ptr(r5), r0
	beq	260$

250$:	movb	-(r1), -(r4)
	sob	r0, 250$

260$:	pop	r3
	mov	Ptr(r5), r1
	movb	r3, (r1)+
	movb	Hdr(r5), (r1)+
	dec	r3

270$:	movb	(r2)+, (r1)+
	sob	r3, 270$

300$:	inc	@Buf(r5)
	inc	Nr(r5)

	pop	<r4, r3, r2, r1, r0>
	rts	pc

proc	ListHd,	<pos, lft>

var	count,	word

var	lft2,	word

begin
	push	<r2, r3, r4>
	mov	pos(r5), r2
	mov	(r2)+, count(r5)

10$:	movb	(r2)+, r3
	beq	100$
	mov	r2, r1
	add	r3, r2
	inc	r2
	bic	#1, r2
	cmpb	(r1), #'+
	bne	30$

	inc	r1
	mov	Lft2(r5), r0
	call	SpcOut
	br	70$

30$:	clr	r4
	bisb	(r1)+, r4
	cmpb	r4, #'Z
	bne	60$
	
	clr	Lft2(r5)
	br	70$

60$:	sub	#'A, r4
	asl	r4
	asl	r4
62$:	push	r1
	mov	Hdrtbl+2(r4), r1
	clr	r0
	bisb	(r1)+, r0
	mov	r0, Lft2(r5)
	call	PrintN
	pop	r1

70$:	dec	r3
	beq	100$
	mov	r3, r0
	call	PrintN
	
100$:	dec	count(r5)
	beq	999$
	call	pcrlf
	bcs	999$
	mov	Lft(r5), r0
	call	SpcOut
	br	10$	

999$:	call	pcrlf
	pop	<r4, r3, r2>
	ret

oSeNtN:	Repars	#3, #GeNamn
	bcs	999$
	cmp	#4, Level
	bne	10$

	mov	#6, r0
	call	fixlst
	bcs	999$
	mov	Found(r0), r1
	call	GetAdr
	mov	rArg(r1), r5		; Get record #.
	mov	@r1, r4
	br	20$

10$:	mov	MyRec, r5
	mov	Me, r4
20$:	mov	Strs+6, r0
	mov	Strs+4, r1
	sub	r1, r0
	dec	r0
	blos	999$
	cmp	#17, r0
	blo	40$
	mov	#TmpStr, r3
	movb	r0, (r3)+		; Length of string.
30$:	movb	(r1)+, r2
	bisb	#40, r2			; Lower case;
	cmpb	r2, #'a
	bhis	50$

40$:	Write	#IligAd
	br	999$

50$:	cmpb	r2, #'z
	bhi	40$
	movb	r2, (r3)+
	sob	r0, 30$

	mov	#TmpStr, r1
	mov	#GRPLST, r0
46$:	call	FindAd
	bcs	60$
	cmp	r4, @r0
	bne	48$
	mov	rNxt(r0), r0
	bne	46$
	br	60$

48$:	Write	#NAIE
	br	999$

60$:	gos	GetRec,	<#1, r5, #FB1,>
	cmp	MyRec, r5
	beq	65$			; User himself => Access granted.

	bit	#ABSPRV, KSW
	bne	70$
	cmp	Me, 10(r1)		; Skaparen
	beq	70$
	Write	#DHIR
	br	100$


65$:	bis	#NetNam, USW		; User got a netname now!

70$:	add	#160, r1
	mov	#TmpStr, r2
	clr	r0
	bisb	(r2)+, r0
	movb	r0, (r1)+
80$:	movb	(r2)+, (r1)+
	sob	r0, 80$

100$:	gos	put,	<#1,,#FB1>
	
999$:	rts	pc

;+
; GetIdS gets the message id string in lower case..
;
; Call		r1, r0 source string (pos, len)
; Return 	r1, r0 destination string
;		r2 position in that string for the "@".
; Carry:n set if somthing was wrong...
;-

oGtIdS:	push	<r3, r4>
	push	r2

10$:	cmpb	#'<, (r1)+
	beq	20$
	sob	r0, 10$
	br	4711$			; Miss!

20$:	clr	r3			; To be pointing at "@".

30$:	movb	(r1)+, r4
	cmp	#'@, r4
	bne	40$
	mov	r2, r3
	br	50$
40$:	cmp	#'>, r4
	beq	70$
	cmp	#'A, r4
	bhi	50$
	cmp	#'Z, r4
	blo	50$
	bis	#40, r4			; Make lowercase.
50$:	movb	r4, (r2)+
	sob	r0, 30$
	br	4711$

70$:	pop	r1
	mov	r2, r0
	sub	r1, r0
	beq	5000$
	mov	r3, r2
	clc
	br	9999$

4711$:	pop	r1
5000$:	clr	r0
	clr	r2
	sec
9999$:	pop	<r4, r3>
	rts	pc
	

;+
; GetHas (Get-Hash)
; call		r0, r1 pointer to sorce string with message-id
; return	r0, r1 logical textnumber
; carry set if text not in KOM.
; Destroys FB2, FB3
;-

oGetHs:	push	<r5, r4, r3, r2>
	tst	r0
	bne	20$

10$:	jmp	4711$

20$:	mov	#FB2, r2
	call	oGtIdS			; Get Id string
	bcs	10$

	mov	r1, r5
	mov	r0, r4
	beq	10$

	tst	r2
	beq	200$			; It's not an KOM Id..

	mov	r4, r3
	add	r5, r3
	sub	r2, r3
	
	beq	200$
	
	mov	#LibInf, r1
	call	GetAdr
	add	#20, r1
	cmpb	r3, (r1)+		; Is it of the right length?
	bne	200$
80$:	cmpb	(r2)+, (r1)+
	bne	200$
	sob	r3, 80$
	
	mov	r5, r1
	mov	r4, r0
90$:	movb	(r1)+, r3
	cmp	#'9, r3
	blo	100$
	cmp	#'0, r3
	bhi	100$
	sob	r0, 90$
	br	110$

100$:	dec	r1
110$:	mov	r1, r0
	sub	r5, r0
	beq	4711$
	mov	r5, r1
	call	Val32
	br	500$

200$:	mov	r5, r1
	mov	r4, r0
	call	oHshIt
	mov	r0, r1
	clr	r0
	div	#200, r0
	add	#2, r0			; Block	Number! (2 = 1'st block)
	asl	r1
	asl	r1			; Address in block

	gos	Get,	<#5, r0, #FB3, #1, #Unlock>
	mov	FB3(r1), r3		; Block
	beq	4711$			; No entry for this id...
	mov	FB3+2(r1), r2		; Position
	

220$:	mov	#FB3, r1
	gos	Get,	<#3, r3, r1, #1, #UnLock>
	add	r2, r1
	mov	#FB2+400, r3
	mov	#8., r2
240$:	gos	GetWrd,	<#FB3>
	mov	r0, (r3)+
	sob	r2, 240$
	gos	GetWrd,	<#FB3>
	mov	r0, r2		; Nr of lines given.
	beq	4711$
	mov	r1, r3
	cmp	#-1,  FB2+400
	bne	4711$
	cmp	#2, FB2+402
	bne	4711$

250$:	call	gtln
	movb	(r1)+, r0
	beq	270$
	cmpb	#'F, (r1)+
	bne	270$
	dec	r0
	bne	300$
270$:	sob	r2, 250$
	
280$:	mov	FB2+400+4, r3		; Block
	beq	4711$
	mov	FB2+400+6, r2		; Position
	br	220$

300$:	mov	#TmpStr, r2
	call	oGtIdS
	bcs	280$
	cmp	r0, r4			; Equal length?
	bne	280$
	mov	r5, r3
310$:	cmpb	(r1)+, (r3)+
	bne	280$
	sob	r0, 310$

	; Found!!!

	mov	FB2+400+14, r1
	mov	FB2+400+16, r0

500$:	tst	(pc)+

4711$:	sec
	pop	<r2, r3, r4, r5>
	rts	pc


TstHsh:	mov	Strs+4, r0
	mov	Strs+2, r1
	sub	r1, r0
	dec	r0
	beq	99$
	call	pcrlf
	call	oGetHs
	bcs	10$
	mov	r1, FB2
	mov	r0, FB2+2
	write	#t1
	mov	#FB2, r1
	clr	r0
	call	deco32
	br	99$
10$:	Write	#t2
99$:	call	pcr2lf
	rts	pc

;+
; HashIt gets the hash-number of a string in r1/r0 (pos/len)
; The returned value in r0 will be between 0 and HshSiz-1
;+

oHshIt:	push	<r2, r3, r4, r5>
	mov	r0, r5
	beq	999$
	movb	(r1)+, r4
	swab	r4
	dec	r0
	beq	100$			; Booring string with just
					; one char...

	bisb	(r1)+, r4
	dec	r0
	beq	100$
10$:	movb	(r1)+, r2
	xor	r2, r5
	mov	#15, r2
	clc
20$:	rol	r5
	rol	r4
	adc	r5
	sob	r2, 20$
	sob	r0, 10$

	; Multiply r4/r5 with 12345847 and leav the lower 32-bits
	; in r0/r1

100$:	mov	#188., r2		; 12345847.
	mov	#25079., r3
	mov	r5, r0
	mul	r3, r0			; 32-bit in r1/r0
	mul	r4, r3			; 16-bit in r3
	mul	r2, r5			; 16-bit in r5
	add	r3, r0
	add	r5, r0

	; Now we just have to take our longword in r0/r1
	; modulus the size of our hash table.
	
200$:	mov	HshSiz, -(sp)		; Denominator.
	call	LDiv			; 32-bit unsigned division
	mov	(sp)+, r0		; Return rest

999$:	pop	<r5, r4, r3, r2>
	rts	pc

Text	GeNamn,	<"Ange internet namn">
Text	NAIE,	<"Namnet var inte entydigt."<Cr><Lf><Cr><Lf>>

IligAd:	.byte	20$-10$
10$:	.ascii	"Felaktigt namn. Namnet f}r vara max 15 tkn 'a' till 'z'."
	.ascii	<Cr><Lf><Cr><Lf>
20$:

Text	T1,	<"Text: ">
Text	T2,	<"Texten finns inte i KOM.">
Text	CnWr,	<"Forts{tt (med att skriva)">
Text	SeT,	<"S{tt">
Text	TvN,	<"Till vilket n{t">
Text	VVDA,	<"Vad vill du ADDERA">
Text	VVDS,	<"Vad vill du SUBTRAHERA">
Text	IAAR,	<" {r redan mottagre."<Cr><Lf><Cr><Lf>>
Text	INAR,	<" {r inte mottagre till denna text."<Cr><Lf><Cr><Lf>>
Text	KES,	<" kan ej s{ttas p} denna text."<Cr><Lf><Cr><Lf>>
Text	BF,	<<Cr><Lf>"KOMs internbuffert {r full."<Cr><Lf><Cr><Lf>>
Text	DMET,	<<Cr><Lf>"Du m}ste ange minst ett To:-f{lt."<Cr><Lf><Cr><Lf>>

NetBuf:
toNtTx:
EoNtBu:
HdrPos:
NetBuf:
AlwHdr:

	.even

	.end