.title	UsNSrv

	.inclu	"b:global"

	UsNPrs	= 919.			; Group # for UseNet

	APR1	= 1
	APR2	= 2
	APR3	= 3
	APR4	= 4
	APR5	= 5

	KIN	= 7			; Channel to use for Writing news

	Tab	= 11
	Spc	= 40

	RhtLim	= 75.
	RhtMrg	= 120.

	.psect	code

	.inclu	"b:komfil"		; KOM filedefinitions.

INIT::	.ttnch				; No Echo
	mov 	#^RUSN, firqb+fqnam1
	mov 	#^RSRV, firqb+fqnam1+2
	.name				; Set work name
	clr	Me
	mov	#LinLen-2, MaxLin
	mov	#-1, Line
	clr	PTerm			; Default term-typ (dummy crt)
	clrb	xrb+xrci
	.postn
	mov	#Width,r0
	clr	(r0)			; ?
	movb	xrb,(r0)
	decb	(r0)
	movb	firqb+fqjob, r0
	asr	r0
	mov	r0, Job
	write	#WlkMes			; Write a friendly phrase with version.
	errprt	#0
	write	#CRLF

	mov	#xSM+xELIN+xFil, MyFlags
	mov	#UnProm, Stat
	clr	KSW
	movb	#UU.SYS,Firqb+fqfun
	clr	firqb+4
	.UUO
	mov	firqb+26,PPN
	movb	Firqb+5,TERM

OPFIL:	mov	#EOFS,r2		; Open files
	mov	#EOFS-Files, r0		; Number of files * 2

10$:	mov	#firqb+fqfun, r1
	movb	#opnfq, (r1)+
	mov	r0, (r1)+		; Unit number * 2
	mov	KOMPPN, (r1)+
	mov	#^RKOM, (r1)+
	mov	-(r2), (r1)+
	mov	#^RDAT, (r1)+
	mov	#1+8.+128.+32768., firqb+fqmode
	mov	KOMDEV, firqb+fqdev
	mov	KOMDVN, firqb+fqdevn
	calfip
	jsr	pc, error
	dec	r0
	sob	r0, 10$
	write	#CRLF

	; Attach to KOM overlay library.

	call	clrfqb
	movb	#ATRFQ, Firqb+fqfil
	mov	KOMLIB, Firqb+12
	mov	KOMLIB+2, Firqb+14
	mov	#1, Firqb+22		; Read Only.
	.plas				; Attach Resedent Library
	call	Error
	mov	Firqb+Fqppn, OLIde
;	mov	Firqb+Fqnam1, OLSiz
	call	clrfqb
	movb	#CRAFQ, Firqb+Fqfil
	movb	#APR3, Firqb+7
	mov	#Firqb+12,r1
	mov	#128., (r1)+
	mov	OLIde, (r1)+
	mov	OvlTbl+SegB, (r1)+
	mov	OvlTbl+SegB+2, (r1)+
	mov	#200,(r1)		; ReadOnly, Mapping.
	.plas
	call	Error
	mov	firqb+fqppn, OWIde	; Window ID
	mov	#SegB, curseg		; Current maped segment.

	; Attach to KOM group-and command library.

	call	clrfqb
	movb	#ATRFQ, Firqb+fqfil
	mov	KOMRES, Firqb+12
	mov	KOMRES+2, Firqb+14
	mov	#2, Firqb+22
	.plas				; Attach Resedent Library
	call	Error
	mov	Firqb+Fqppn, LibIde
	mov	Firqb+Fqnam1, LibSiz
	call	clrfqb
	movb	#CRAFQ, Firqb+Fqfil
	movb	#APR4, Firqb+7
	mov	#Firqb+12,r1		; There WAS a bug here!
	mov	#128., (r1)+
	mov	LibIde, (r1)+
	clr	(r1)+
	clr	(r1)+
	mov	#202, (r1)		; Write access and Mapping
	.plas
	call	Error
	mov	firqb+fqppn, WinIde	; Window ID
	clr	CurSek			; Current maped sektion.
	
	mov	#100, ResLim
	bis	#UseRes, KSW		; Now we uses a RESLIB
					;  for our commands.

	mov	#2,r2
	gos	Get, <#1, r2, #FB1, #1, #Lock>	; Get INFO-block
	cmp	#xDBVer, FB1+32	; Right DATABASE Version
	beq	20$
	iot

20$:	bit	#1, FB1+34
	beq	40$
	mov	#1,r0
	call	Releas
	Write	#KOMAVS
	jmp	$exit

40$:	mov	FB1+110, HshSiz
	mov	FB1+112, HshEnd

ALIINI:	mov	#Alias1, r1		; Alias INIT.
	mov	r1, LstMem
	clr	(r1)+
	mov	#GRPLST, (r1)+		; Link to KOMRES.
	clr	(r1)+			; rArg
	clr	(r1)+			; Priority none.
	clr	(r1)+			; rPri2
	clr	(r1)+			; rTyp
	clr	(r1)+			; rStr
	mov	r1, NxtMem
	
	mov	#BasAdr, r5		; LIBINF
	cmp	#xLibUi, (r5)
	beq	RESINI
	jmp	CONT

RESINI:	mov	#1, r0			; Init. Resedent Library
	call	Exlock
	mov	#xLibIn, (r5)+
	mov	FB1+22, (r5)+		; # of created text's
	mov	FB1+24, (r5)+
	mov	#17, (r5)+		; Edit # for groups
	mov	#17, (r5)+		; Edit # for texts
	mov	FB1+34, (r5)+		; DSW
	clr	(r5)+			; LSW2
	mov	#FB1+62, r1
	mov	(r1)+, (r5)+		; N[TPERSON n
	movb	(r1)+, r0
	movb	r0, (r5)+
5$:	movb	(r1)+, (r5)+		; KOM's net-address
	sob	r0, 5$
	mov	#PreLst, r1
	call	GetAdr
	mov	r1, r5
	mov	#64.*4, r0
10$:	clr	(r5)+
	sob	r0, 10$
	mov	FB1+30, r4		; Number of groups.
	mov	FB1+42, tmp
	mov	#FSTGRP, NxtAdr		; Start addres of grouplist
	mov	#GRPLST, LstAdr		; Previous linked group.
	mov	LibSiz, r1
	asr	r1
	asr	r1
	bic	#177037, r1
	mov	r1, LibSiz		; Highest possible sektion.
	clr	r1			; Number of linked groups.

INLNK:	mov	r4,r3
	beq	50$
	cmp	#<<EOFB4-STKEND+2>/1000>*10, r3	; Maximum number of groups
	bhis	10$				;  to be read.
	mov	#<<EOFB4-STKEND+2>/1000>*10, r3
10$:	mov	r3,r5
	dec	r5
	ash	#-3,r5			; Number of blocks left to get
	inc	r5
	mov	#stkend+2,r0
	gos	Get, <#4, r2, r0, r5, #Unlock>
	add	r5,r2
20$:	inc	r1
	dec	r4
	tst	(r0)
	beq	30$
	call	maklst
	cmp	#-1, NxtAdr
	beq	50$
30$:	add	#64.,r0
	sob	r3,20$
	br	INLNK

50$:	mov	#LibInf, r1
	call	GETADR
	mov	r1,r5
	add	#100, r1
	mov	LstAdr, (r1)+
	mov	NxtAdr, (r1)+
	mov	LibSiz, (r1)
	mov	#xLibRd, (r5)
	mov	#1, 10(r5)		; Edit # for texts

	mov	#Mutex, r1
	call	GetAdr
	mov	#-1, (r1)+		; Init value for this semaphore.
	clr	(r1)+			; Owner job nr (no one now).

CONT:	mov	#1, r0
	call	Releas
	
505$:	cmp	#xLibRd, (r5)
	beq	530$

510$:	cmp	#xLibIn, (r5)		; This is not possible!
	beq	520$			; You can't be here!
	iot

520$:	mov	#2, xrb
	.sleep
	br	505$
	
530$:	mov	6(r5), EditNr
	
PseWho::

	mov	#stack, sp
	mov	#ovlstk, ovlsp
	mov	#UsNPrs, r0
	mov	r0, Me
	mov	#GRPLST, r1
	call	FindCm
	tst	r0
	bne	10$
	jmp	quit$
10$:	mov	rArg-rStr(r0), MyRec
	mov	rHigh-rStr(r0), MyHigh
	gos	GetMe,	<#FB1>
	clr	NrCrTx
	mov	102(r1), MyRead
	mov	104(r1), MyPoin
	mov	106(r1), FileNr
	mov	142(r1), NrDist
	mov	144(r1), DstRec
	
RNEWS:	mov	me, r0
	call	GetHig
	mov	r0, MyHigh
	mov	MyRead, r0
	cmp	MyRead, MyHigh
	bhis	WNEWS
	call	FixLet
	tst	unrel
	beq	WNEWS
	tst	@unrel
	beq	WNEWS

10$:	call	RdLet
	mov	MyRead, r0
	tst	@unrel
	bne	10$
	br	RNEWS

WNEWS:	tst	NrDist
	beq	$FIN
	clr	r5
10$:	gos	wopen <#KIN,#INFILE,>; Wild open next file (always first 
				     ;   file)
	bcs	$FIN

	mov	#'<, r0
	call	ttyout
	call	WrFiNa
	inc	r5
	gos	DoWrtN
	bcc	20$

	Write	#NoRece

20$:	call	pcrlf

	call	RstFqb
	call	kill			; Don't need the file no more!
	br	10$
	
$FIN:	call	MtxBgn
	gos	LockMe,	<#FB1>
	add	NrCrTx,	100(r1)
	mov	MyRead, 102(r1)
	mov	MyPoin, 104(r1)
	mov	FileNr, 106(r1)
	gos	Put,	<#1,, #FB1>	
	call	MtxEnd
	call	pcrlf
	jmp	quit$


proc	DoWrtN

var	EB,	word
var	EO,	word
var	TB,	word
var	TO,	word
var	RC,	word			; Receiver of this letter!
var	CT,	word			; Comment-To text # (physical)
var	SW,	word			; Status Word for TEXT
var	PV,	word			; Previous receiver-link
var	SC,	word

var	HashNr,	word
var	NxtR,	word
var	NetR,	word
var	Str,	word
var	Count,	word
var	Count2,	word
var	Flag,	word

begin
	clr	CT(r5)			; Comment to nothing by default
	mov	#xEXT!xEXIN, SW(r5) 	; Default status word
	clr	NrLine			; # of lines in text
	clr	NrHdrL			; # of header lines
	clr	NrRece			; Nr of receivers
	clrb	SubBuf			; Subject-line.

 ; 1'st thing: Get the recievier and the In-Rep-To-field from the text.
 ; At the same time: Count # of lines and move from:- and sender:-lines
 ; to the top.

	mov	#FB1, r4
	gos	Get,	<#-KIN, #1, r4, #1,>
	bcc	10$

3$:	jmp	4711$			; Why send an empty file?

10$:	gos	GetHdL	<#False>	; Returns ptr in r1, len in r0.
	bcs	3$			; End Of file => No text at all.

	tst	r0
	bne	15$
	tst	EoHdP
	bne	100$

15$:	mov	20$(r2), r2
	beq	50$
	call	@r2
	br	50$

20$:	.word	SavFrm			; From
	.word	30$			; To
	.word	0			; Sender
	.word	0			; Bcc
	.word	0			; Date
	.word	40$			; Message-Id
	.word	0			; Reply-To
	.word	0			; In-Reply-To
	.word	0			; Received
	.word	0			; cc
	.word	SavSub			; Subject
	.word	SavNwG			; Newsgroups
	.word	30$			; Lines
	.word	SavRef			; References
	.word	0			; Keywords
	.word	0			; Organization
	.word	30$			; Xref
	.word	0			; Followup-To
	.word	30$			; Path
	.word	0			; Outher..

30$:	dec	NrHdrL			; Skip this header!
	tst	MoreP
	beq	35$
	gos	GetHdL	<#True>
	bcc	30$
	jmp	4711$
35$:	rts	pc

40$:	call	GetMId
	mov	r0, HashNr(r5)
	rts	pc

50$:	tst	MoreP
	beq	10$
	gos	GetHdL	<#True>
	bcc	50$

70$:	jmp	4711$

100$:	tst	NrRece
	beq	70$			; No Receiver => Return with error!
	tst	NrFrom
	beq	70$			; No author => Return with error!
	
	clr	Flag(r5)

105$:	call	RdLine			; Must count nr of lines...
	bcs	110$
	tst	r0
	beq	107$
	tst	Flag(r5)
	bne	107$

	inc	Flag(r5)
	call	GetCom
	mov	r0, CT(r5)
	beq	107$
	bis	#xKom, SW(r5)

107$:	inc	NrLine
	br	105$

; Ok, now we now what to do! Time to lock for the receivers.

110$:	clr	TB(r5)			; Indicating that no text 
	mov	#ToBuff, Str(r5)	;   is saved.
	clr	PV(r5)
	clr	SC(r5)

200$:	mov	DstRec, NxtR(r5)
	mov	NrDist, Count(r5)
	mov	Str(r5), r2			; Get next newsgroup.
	movb	(r2), r0
	beq	230$
	add	r0, Str(r5)
	inc	Str(r5)

220$:	mov	NxtR(r5), r0
	beq	230$			; Not in KOM, try next.
	gos	GetRec,	<#1, r0, #FB1, #UnLock>
	mov	2(r1), NxtR(r5)
	call	EqlNwG			; Do we got right group?
	bcc	240$			; Yes, goto 240$
	dec	Count(r5)
	bne	220$
230$:	jmp	500$

; Newsgroup found! Now we just have to send it according to
; distribution list.

240$:	mov	6(r1), Count2(r5)
	beq	230$
	mov	10(r1), r0
	beq	230$

260$:	gos	GetRec,	<#1, r0, #FB1, #UnLock>
	mov	2(r1), NxtR(r5)
	mov	#DstNod, r2
	mov	#100, r0
270$:	mov	(r1)+, (r2)+
	sob	r0, 270$
	mov	#20., Count(r5)
	mov	#DstNod+10, r2

280$:	mov	(r2)+, RC(r5)

	mov	(r2)+, NetR(r5)
	beq	350$
	
	mov	#FB3, r3
	clr	(r3)+
	clr	(r3)+
	clr	(r3)+			; Nr of headers this far...
	clr	FB1-2
	mov	#'B, r4
290$:	gos	TryRec,	<#1, NetR(r5), #FB1, #Unlock>
	mov	2(r1), NetR(r5)
	add	#14, r1

	clr	r0
	bisb	(r1)+, r0
	movb	r0, (r3)
	incb	(r3)
	tst	NetR(r5)
	beq	300$
	incb	(r3)			; More to come, make room for a ",".
300$:	inc	r3
	movb	r4, (r3)+		; "To:" - field.
	mov	#'+, r4			; Next field will be of the same type.
310$:	movb	(r1)+, (r3)+
	sob	r0, 310$
	tst	NetR(r5)
	beq	320$
	movb	#',, (r3)+
320$:	inc	FB3+4
	tst	NetR(r5)
	bne	290$

	mov	#FB3, NetR(r5)

350$:	tst	(r2)+

	tst	TB(r5)
	bne	355$

; There was at least one receiver => Send it to him!

	call	Get1st			; Lock block #1 of file 3. 
	mov	r3, EB(r5)		; Save block # for EXTERN node
	mov	r4, EO(r5)		; Calculate offset for EXTERN node
	mov	r3, TB(r5)
	mov	r4, TO(r5)
	add	#FB4, r4	
	call	PtHead
	bit	#1, r4
	beq	352$
	clr	r0
	call	PutChr			; Evenize..
352$:	mov	r4, TO(r5)
	sub	#FB4, TO(r5)
	mov	FB4-2, TB(r5)
	call	PtText
	call	putlst			; Put last block of file 3. Unlock

355$:	mov	TB(r5), r0
	mov	TO(r5), r1
	mov	NetR(r5), r0
	beq	360$

	gos	MakLet, <Me, RC(r5), SW(r5), CT(r5), r0, PV(r5)>
	br	400$

360$:

   gos	mklet2 <EB(r5),EO(r5),Me,SW(r5),RC(r5),TB(r5),TO(r5),CT(r5),PV(r5)>

400$:	mov	r1, TxtNr
	mov	r0, TxtNr+2
	mov	tmp+16, PV(r5)		; Record nr (To previous receiver).
	tst	SC(r5)
	bne	420$
	mov	PV(r5), SC(r5)		; 1'st receiver in chain.

420$:	gos	IntLnk,	<RC(r5), SW(r5), CT(r5)>

	inc	NrCrTx

	dec	Count2(r5)
	beq	500$
	dec	Count(r5)
	beq	440$
	jmp	280$
440$:	mov	NxtR(r5), r0
	beq	500$
	jmp	260$

500$:	dec	NrRece
	beq	550$
	jmp	200$

550$:	tst	SC(r5)
	beq	4711$		; No receiver in KOM.
	cmp	SC(r5), PV(r5)	; More than one Receiver?
	beq	700$

	call	MtxBgn

	push	PV(r5)		; Last Record

560$:	gos	GetRec,	<#2, PV(r5), #FB1,> ; Yes, link MultiR.

570$:	bis	#xMulR, 14(r1)		; Got a multireceivet-link.
	mov	SC(r5), 34(r1)
	mov	PV(r5), SC(r5)
	mov	36(r1),  PV(r5)
	beq	580$

	gos	PutGet,	<#2, PV(r5), #FB1>
	br	570$

580$:	mov	(sp)+, 36(r1)
	gos	put, <#2,, #FB1>

	call	MtxEnd

700$:	gos	InToHs	<HashNr(r5), EB(r5), EO(r5)>

1000$:

2000$:	mov	#2, r4			; Good! The file was excellent!
	br	9999$

4711$:	clr	r4			; Error! Return with carry set...

9999$:	gos	close <#KIN>		; Close the channel in case it was open
	add	r4, pc			; !
	sec
	ret

EqlNwG:	push	<r0, r1, r2>
	mov	r2, r0
	add	#14, r1
	call	EqualP
	pop	<r2, r1, r0>
	rts	pc

GetCom:	push	r2
	mov	r2, r0
	call	GetHsh
	bcs	99$
	mov	#FB2+2, r2
	mov	r0, (r2)
	mov	r1, -(r2)
	mov	r2, r0
	mov	r2, r1
	call	CnvLet
	bcc	100$
99$:	clr	r0
100$:	pop	r2
	rts	pc

ExP:	push	r0
	mov	#'>, r0
	call	ttyout
	call	ttyin
	cmp	#'., r0
	beq	10$
	pop	r0
	rts	pc

10$:	jmp	$EXIT

proc	InToHs	<HashNr, ExtBlk, ExtPos>

	begin
	push	<r2, r3, r4>
	mov	HashNr(r5), r1
	clr	r0
	div	#200, r0
	add	#2, r0			; Block	Number! (2 = first block)
	asl	r1
	asl	r1			; Address in block
	call	MtxBgn
	gos	Get,	<#5, r0, #FB4, #1,>
	add	#FB4, r1
	mov	(r1), r2		; Block
	mov	ExtBlk(r5), (r1)+
	mov	(r1), r3		; Position
	mov	ExtPos(r5), (r1)
	gos	Put,	<#5,,#FB4>
	call	MtxEnd
	tst	r3
	beq	100$

	mov	#FB4, r4
	gos	GetRec <#3, r2, r4,>
	mov	r3, r1
	add	r4, r1
	gos	GetWrd	<#FB4>
	cmp	#-1, r0
	beq	50$

40$:	clr	r2			; Cut of pointer to sick EXTERN.
	clr	r3
	br	100$

50$:	gos	GetWrd	<#FB4>
	cmp	#2, r0
	bne	40$
	gos	GetWrd	<#FB4>
	gos	GetWrd	<#FB4>
	mov	r1, r4
	mov	ExtBlk(r5), r0
	call	PutWrd
	mov	ExtPos(r5), r0
	call	PutWrd
	gos	Put	<#3,, #FB4>		

100$:	gos	GetRec <#3, #1, #FB4,>	; First block.
	mov	#3, r0
	call	exlock			; Lock it

	mov	#FB4, r4
	gos	GetRec <#3, ExtBlk(r5), r4,>
	add	ExtPos(r5), r4
	mov	#-1, r0
	call	PutWrd
	mov	#2, r0
	call	PutWrd
	mov	r2, r0
	call	PutWrd
	mov	r3, r0
	call	PutWrd
	clr	r0
	call	PutWrd
	call	PutWrd
	mov	TxtNr, r0
	call	PutWrd
	mov	TxtNr+2, r0
	call	PutWrd
	gos	Put,	<#3,, #FB4>
	mov	#3, r0
	call	Releas
	pop	<r4, r3, r2>
	ret	

PtText:	push	<r5, r2>
	
	mov	#txhdr, r1
	movb	(r1)+, r2
10$:	movb	(r1)+, r0
	call	PutChr
	sob	r2, 10$

	mov	NrLine, r0		; # of lines.
	inc	r0			; One extra for the subject-line.
	call	PutChr
	swab	r0
	call	PutChr

	mov	r4, r5
	mov	r3, r4
	mov	#Buff2, r3
		
	mov	#SubjT, r1
	movb	(r1)+, r0
	call	SavLin
	mov	#SubBuf, r1
	movb	(r1)+, r0
	call	SavLin
	call	PutLin

50$:	call	RdLine
	bcs	999$			; This will occour....
	mov	r2, r0
	call	SavLin
	call	PutLin
	dec	NrLine
	bne	50$

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

PtHead:	push	<r5, r2>

	mov	#xthdr, r1
	movb	(r1)+, r2
10$:	movb	(r1)+, r0
	call	PutChr
	sob	r2, 10$
	mov	NrHdrL, r0
	call	PutChr
	swab	r0
	call	PutChr

	mov	r4, r5
	mov	#Buff2, r3

; r5 = Pinter in FB4, r4 =  FB1 (KIN), r3 = buffer.


40$:	mov	NrFrom, r2
	beq	70$
	mov	#FrBuff, r4
	mov	#'A, r0

50$:	call	SavChr
	movb	(r4)+, r0
	mov	r4, r1
	add	r0, r4
	call	SavLin
	dec	r2
	beq	60$
	call	PutLin
	mov	#'+, r0
	br	50$

60$:	call	PutLin

70$:	mov	#FB1, r4
	gos	Get,	<#-KIN, #1, r4, #1,>
		
80$:	clr	HdrSpc
	gos	GetHdL	<#False>
	bcs	4711$

	tst	r0
	bne	85$
	tst	EoHdP
	bne	200$
	
85$:	push	r0
	mov	HdrPrf(r2), r0
	beq	190$
	tst	HeadTB(r2)		; Uknown header?
	beq	150$			; Yes => goto 150$
	call	SavChr
90$:	pop	r0
	call	SavLin
	call	PutLin
	br	170$

150$:	call	SavChr
	push	r1
	mov	#HdrStr, r1
	movb	(r1)+, r0
	beq	170$
	mov	r0, HdrSpc
	add	#2, HdrSpc
	bicb	#40, (r1)		; Uppercase!
	call	SavLin
	mov	#':, r0
	call	SavChr
	mov	#Spc, r0
	call	SavChr
	pop	r1
	br	90$

170$:	tst	MoreP
	beq	80$
	
	gos	GetHdL	<#True>
	bcs	4711$
	tst	r0
	beq	170$
	push	r0
	mov	#'+, r0
	call	SavChr
	mov	HdrSpc, r2
	beq	180$
	mov	#Spc, r0
175$:	call	SavChr
	sob	r2, 175$
180$:	pop	r0
	call	SavLin
	call	PutLin
	br	170$

190$:	pop	r0
195$:	tst	MoreP
	beq	80$
	gos	GetHdL	<#True>
	bcs	4711$
	br	195$

200$:
2000$:	tst	(pc)+
4711$:	sec
	mov	r4, r3
	mov	r5, r4
	pop	<r2, r5>
	rts	pc

PutWrd:	mov	r0, (r4)+
	cmp	r4, #FB4+1000
	blo	100$
	gos	put <#3, ,#FB4>

	push	r0
	mov	#FB4-2, r4
	mov	(r4)+, r0
	inc	r0
	gos	Get,	<#3 ,r0 ,r4 , #1,>
	pop	r0

100$:	rts	pc


SavChr:	movb	r0, (r3)+
	rts	pc

SavLin:	push	<r0, r1>
	tst	r0
	beq	99$
10$:	movb	(r1)+, (r3)+
	sob	r0, 10$
99$:	pop	<r1, r0>
	rts	pc

PutLin:	push	<r0, r1, r4>
	mov	r5, r4
	mov	#Buff2, r1
	sub	r1, r3
	mov	r3, r0
	call	PutChr
	tst	r0
	beq	99$
10$:	clr	r0
	bisb	(r1)+, r0
	call	PutChr
	sob	r3, 10$

99$:	mov	#Buff2, r3
	mov	r4, r5
	pop	<r4, r1, r0>
	rts	pc

SavNwG:	push	<r3, r2>
	clr	NrRece
	mov	#ToBuff, r3
10$:	mov	r3, r2
	clrb	(r2)+
	call	GtNeAd
	tst	r0
	beq	30$
	add	r0, r1
	cmpb	#',, -(r1)
	bne	20$
	dec	r0
20$:	movb	r0, (r3)+
	add	r0, r3
	inc	NrRece
30$:	tst	MoreP
	beq	999$
	gos	GetHdL	<#True>	
	br	10$

999$:	pop	<r2, r3>
	rts	pc

SavFrm:	push	r3
	clr	NrFrom
	mov	#FrBuff, r3
10$:	tst	r0
	beq	30$
	mov	r3, r2
	movb	r0, (r3)+
20$:	movb	(r1)+, (r3)+
	sob	r0, 20$
	inc	NrFrom
30$:	tst	MoreP
	beq	999$
	gos	GetHdL	<#True>	
	br	10$

999$:	pop	r3
	rts	pc

SavRef:	push	r3
	mov	#RfBuff, r3
	clr	(r3)+
10$:	tst	MoreP			; We are interseted in the very last
	beq	20$			; reference...
	gos	GetHdL	<#True>	
	br	10$
20$:	tst	r0
	beq	999$
	add	r0, r1
30$:	cmpb	#'<, -(r1)
	beq	50$
	sob	r0, 30$


	mov	r3, r2
	movb	r0, (r3)+
30$:	movb	(r1)+, (r3)+
	sob	r0, 20$
	inc	NrFrom
30$:
999$:	pop	r3
	rts	pc

SavSub:	push	r3
	mov	#SubBuf, r3
10$:	movb	r0, (r3)+
	beq	999$
20$:	movb	(r1)+, (r3)+
	sob	r0, 20$
999$:	dec	NrHdrL			; This is to be counted as a text-
	tst	MoreP
	beq	1000$
	gos	GetHdL,	<#True>
	br	999$
1000$:	pop	r3			; line..
	rts	pc

GetMId:	push	<r1, r2>
	mov	#TmpStr, r2
	call	GetIdS
	bcs	99$
	call	HashIt
	br	100$
99$:	clr	r0
100$:	pop	<r2, r1>
	rts	pc

;+
; EqlHdr checks if current header match header string in r0
;-

EqlHdr:	push	<r1, r2>
	mov	#HdrStr, r1
	call	EqualP
	pop	<r2, r1>
	rts	pc

;+
; GetHdL (Get-Header-Line)
; Return: Header (In lower case without ":") in HdrStr
;	  r2, index to HeadTB to found header.
;	  Rest in LinBuf, r1/r0 = Pos/Len
; Input is terminated at every "," and MoreP is set to True.
;-

proc	GetHdL,	<More>

var	SpcFlg,	word
var	BraFlg,	word
var	AbrLim,	word

begin
	push	r3
	mov	#FB1+1000, r3		; limit.
	clrb	LinBuf
	clr	MoreP
	clr	EoHdP
	mov	HdrIdx, r2
	tst	More(r5)
	bne	48$
	mov	#HdrStr, r1
	clrb	(r1)+
	
10$:	call	GetChr
	bcc	13$

12$:	jmp	1000$

13$:	cmp	#Cr, r0
	bne	15$
	call	GetChr
	bcs	12$			; jmp 1000$
	cmp	#Lf, r0
	bne	15$
	jmp	500$
	
15$:	cmp	#':, r0
	beq	40$
	cmp	#Spc, r0		; Skip all spaces and tabs in
	beq	30$			; header-name.
	cmp	#Tab, r0
	beq	30$
	cmp	#'A, r0
	bhi	20$
	cmp	#'Z, r0
	blo	20$
	bisb	#40, r0			; Make it lower-case.
20$:	movb	r0, (r1)+
30$:	br	10$

40$:	sub	#HdrStr+1, r1
	movb	r1, HdrStr		; Set stringlength
	clr	r2
	
42$:	mov	HeadTB(r2), r0
	beq	46$
	call	EqlHdr
	bcc	46$
	tst	(r2)+
	br	42$

46$:	mov	r2, HdrIdx

48$:	inc	NrHdrL

	mov	HdrPrf(r2), r0
	mov	NrHdrL, r1

	mov	#LinBuf+1, r1
	clr	SpcFlg(r5)		; Space flag (Skip leeding spaces).
	clr	BraFlg(r5)
	movb	HdrStr, r0
	neg	r0
	add	#LinBuf+RhtLim, r0
	cmp	#SubTb-HeadTB, r2	; Don't cut subject line...
	beq	4805$
	tst	IsAdrF(r2)
	beq	49$
4805$:	add	#RhtMrg-RhtLim+2, r0
49$:	mov	r0, AbrLim(r5)

50$:	call	GetChr
	bcs	1000$

	cmp	#Cr, r0
	bne	60$
	call	GetChr
	bcs	1000$
	cmp	#Lf, r0
	bne	60$

	call	GetChr			; Was next?
	bcs	54$
	cmp	#Spc, r0		; Doesit continue on next line?
	beq	55$			; yes, merge the two lines...
	cmp	#Tab, r0
	beq	55$
54$:	dec	r4			; Put it back! Just watching...
	br	150$
55$:	tst	IsAdrF(r2)
	bne	70$
	br	66$	

60$:	tst	BraFlg(r5)
	beq	62$

	cmp	#'), r0
	bne	82$
	dec	BraFlg(r5)
	br	82$

62$:	cmp	#'(, r0
	bne	64$

	inc	BraFlg(r5)
	br	82$

64$:	tst	IsAdrF(r2)		; Is this an address-field?
	beq	68$			; No.
	cmp	#',, r0
	bne	68$

	movb	r0, (r1)+

66$:	dec	MoreP			; One more af this kind to get!
	br	150$

68$:	cmp	#Spc, r0		; Space
	bne	80$

70$:	mov	#Spc, r0
	inc	SpcFlg(r5)		; Space flag
	bne	100$
	br	82$	
	
80$:	cmp	#Tab, r0		; Tab
	beq	70$
	mov	#-1, SpcFlg(r5)		; flag = Take next space...

82$:	cmp	r1, AbrLim(r5)
	blt	90$

84$:	cmpb	#Spc, r0
	beq	66$
	cmpb	#tab, r0
	beq	66$
	movb	r0, -(r4)
	cmp	#LinBuf+30., r1
	bhis	66$
	movb	-(r1), r0
	br	84$

90$:	movb	r0, (r1)+
	cmp	r1, #LinBuf+RhtMrg
	bge	66$

100$:	br	50$

150$:	mov	r1, r0
	mov	#LinBuf, r1
	sub	r1, r0
	dec	r0
	movb	r0, (r1)+
	br	700$

500$:	clr	r0
	clr	r2
	dec	EoHdP			; End of header fields!

700$:	tst	(pc)+

1000$:	sec

9999$:	pop	r3
	ret

;+
; GetRce returns group-number in KOM of the receiver to the text.
; Call r1 = Pointer to string. r2 = length.
; Return r0 = Groupnumber or zero.
;-

GetRce:	mov	r2, r0
	beq	100$			; No receiver here!
	mov	#ToBuff+1, r2
	call	GtNeAd			; GetNetAddress
	bcs	100$

	push	<r1, r0>		; Save pointer

10$:	movb	(r1)+, r2
	cmp	#'@, r2
	beq	20$
	cmp	#'A, r2
	bhi	15$
	cmp	#'Z, r2
	blo	15$
	bisb	#40, -1(r1)		; Make it lower case
15$:	sob	r0, 10$

20$:	sub	(sp)+, r0		; Use everything before the "@".
	neg	r0
	pop	r1
	movb	r0, -(r1)		; set new length

50$:	mov	#GrpLst, r0
	call	FindAd
	bcs	100$
	mov	(r0), r0
	br	999$

100$:	clr	r0

999$:	rts	pc

;+
; GtNeAd - GetNetAddress returns the address stripped from
; spaces and comments.
; Call:		r0, r1:	Len, pos of line to be converted.
;		r2 :	Destination string.
; Return:	r0, r1: Len, pos of destination string.
; carry set if no address was found at all.
;-

GtNeAd:	push	<r5, r4, r3, r2>	; r2 must be top of stack!

	clr	r4			; () - level.
	clr	r5			; Inside <> - flag.

10$:	movb	(r1)+, r3
	cmp	#'(, r3
	bne	20$

	inc	r4
	br	100$

20$:	cmp	#'), r3
	bne	30$

	dec	r4
	bpl	100$
	clr	r4
	br	100$

30$:	tst	r4			; Are we inside a comment?
	bne	100$			; Yes! Goto 100$
	
	cmp	#Spc, r3		; Skip all white-spaces..
	beq	100$
	cmp	#Tab, r3
	beq	100$

	tst	r5
	bne	50$

	cmp	#'<, r3
	bne	90$

	inc	r5
	mov	(sp), r2		; Return only whats between the
	br	100$			; brackets.

50$:	cmp	#'>, r3
	beq	120$			; Thats it!

90$:	movb	r3, (r2)+

100$:	sob	r0, 10$

120$:	mov	(sp), r1		; Address of line.
	mov	r2, r0			; Address to end of line.
	sub	r1, r0			; Length of line.
	beq	200$

	tst	(pc)+

200$:	sec

	pop	<r2, r3, r4, r5>
	rts	pc

;+
; RdLine transfers a line from KIN/FB1/r4 to LinBuf/r1/r2
; Returns:	r1 ponter to 1'st byte in LinBuf
;		r2, length of line...
;-

RdLine:	push	r3
	mov	#FB1+1000, r3
	mov	#LinBuf+1, r1
	clr	r2
10$:	call	GetChr	
	bcs	99$

	cmp	#Cr, r0
	bne	20$
	call	GetChr
	bcs	99$
	cmp	#Lf, r0
	beq	30$
	
20$:	movb	r0, (r1)+
	inc	r2
	cmp	#RhtMrg, r2
	bhis	10$

30$:	mov	#LinBuf, r1
	movb	r2, (r1)+		; Save length of line

	clc

99$:	pop	r3
	rts	pc

GetChr:	cmp	r4, r3
	blo	50$
	mov	#FB1, r4
	gos	Get,	<#-KIN,,r4,#1,>	; Get next block.
	bcs	99$
50$:	clr	r0
	bisb	(r4)+, r0
	beq	GetChr			; Skip Nulls
	clc
99$:	rts	pc	
	
proc	clink	<toprec,comrec,buffer>
var	tmprec,	word
begin
	call	MtxBgn
	gos	getrec	<#2, toprec(r5), buffer(r5),>
	tst	32(r1)			; Any comments already?
	bne	230$
	mov	comrec(r5), 32(r1)	; comrec(r5) is current record
	gos	put	<#2,,buffer(r5)>
	br	250$

230$:	mov	#2, r0
	call	release			; Release the lock
	mov	32(r1), tmprec(r5)
	gos	tryrec	<#2, 32(r1), buffer(r5),>
	mov	30(r1), toprec(r5)
	mov	comrec(r5), 30(r1)
	tst	toprec(r5)
	bne	233$
	mov	tmprec(r5), toprec(r5)
	br	235$

233$:	gos	putget	<#2, toprec(r5), buffer(r5)>
235$:	mov	comrec(r5), 26(r1)
	gos	putget	<#2, comrec(r5), buffer(r5)>
	mov	toprec(r5), 30(r1)
	gos	put	<#2,,buffer(r5)>
	call	MtxEnd
250$:	ret


WrFiNa:	push	<r0, r1, r2>
	mov	#TmpStr, r2
	mov	#FqbBuf+FqNam1, r1
	mov	(r1)+, r0
	call	r50unp
	mov	(r1)+, r0
	call	r50unp
	mov	#'., (r2)+
	mov	(r1)+, r0
	call	r50unp
	mov	r2, r0
	mov	#TmpStr, r1
	sub	r1, r0
	call	PrintN
	pop	<r2, r1, r0>
	rts	pc

;+
; R50UNP
; Unpack a 3 char RAD50 symbol to ASCII
;
; Enter with R2 -> Output ASCII string
; 	     r0 -> RAD50 symbol to unpack
;
; Return with R2 -> Past output string
;
; Reference to MACRO language Manual for more detailes
;-

R50UNP:	push	<r0, r1, r3, r4>
	mov	r0, r4
1$:	mov	r4, r1
	mov	#50*50, r3
	call	10$
	mov	#50, r3
	call	10$
	mov	r1, r0
	call	11$
	pop	<r4, r3, r1, r0>
	rts	pc

10$:	clr	r0
	div	r3, r0
11$:	tst	r0
	beq	23$
	cmp	r0, #33
	blt	22$
	beq	21$
	add	#22-11, r0
21$:	add	#11-100, r0
22$:	add	#100-40, r0
23$:	add	#40, r0
	movb	r0, (r2)+
	rts	pc

RdLet:	tst	unrel
	bne	10$

5$:	jmp	1000$

10$:	mov	@unrel, r1
	beq	5$
	cmp	#-1, r1
	bne	100$

	push	#10$

20$:	add	#2, unrel
	mov	@unrel, mypoin
	add	#2, unrel
	rts	pc

100$:	add	#2, unrel
	cmp	#-1, @unrel
	bne	200$
	call	20$

200$:	inc	myread
	mov	r1, OldL
	mov	#FB4, CurBlk
	clrb	InRpTo
	clr	ComntP

	call	MtxBgn

	gos	GetRec,	<#2, r1, CurBlk,>
	mov	r1, r5
	.date
	mov	xrb, 44(r1)		; Set received-datum...
	mov	xrb+2, 46(r1)
	gos	Put,	<#2,, CurBlk>

	call	MtxEnd

	add	#6, r1
	call	GetDat

	mov	12(r5), r0
	call	GetFrm
	bcs	1000$
	
	mov	r5, r1
	call	MrkHdr

	mov	r5, r1
	call	GetIRT

	tst	OutTbP+2		; Nr of receivers
	beq	1000$			; No receiver => exit!

300$:	call	OpnNxt
	
	Write	#PthUfh
	Write	#frmPth
	call	pcrlf

320$:	mov	#zFrom, r1
	tst	OutTbP
	beq	325$
	mov	#zSend, r1
325$:	call	strout
	Write	#From

	call	DspHd

	Write	#zDate
	Write	#Date
	call	pcrlf
	
	Write	#zID
	mov	#TxtNr, r0
	call	MakeID
	call	strout
	call	pcrlf

340$:	tstb	InRpTo
	beq	350$
	tst	OutTbP+30
	bne	350$

	Write	#zRefer
	Write	#InRpTo
	call	pcrlf

350$:	Write	#zOrg
	Write	#OrgUfh
	call	pcrlf

390$:	gos	OutTxt,	<20(r5), 22(r5), #FB3>

	bic	#UtmOn, KSW
	call	UtmOff

1000$:	rts	pc

OpnNxt:	push	<r0, r1, r2, r3, r4, r5>
	mov	FileNr, r1
	mov	#OutFil+7, r2
	mov	#4, r3
20$:	clr	r0
	div	#10., r0
	add	#'0, r1
	movb	r1, -(r2)
	mov	r0, r1
	sob	r3, 20$
30$:	mov	#'>, r0
	call	ttyout
	mov	#OutFil, r1
	call	strout
	call	pcrlf
	inc	FileNr
	call	opnfil
	bis	#UtmOn, KSW
	pop	<r5, r4, r3, r2, r1, r0>
	rts	pc

;+ Data passed: R1, The address of a 2-word block containing date in RSTS/E
;		    internal format.
;-
GetDat:	push	<r0, r1, r2, r3>
	mov	(r1)+, firqb+4
	mov	(r1), firqb+22
	movb	#uu.cnv, firqb+fqfun
	mov	#-1, firqb+6		; DD-MON-YY format!
	mov	#1, firqb+24		; 24-hour time
	.uuo	
	mov	#firqb+10, r1
	mov	#firqb+21, r0
	mov	#Date+1, r2
20$:	cmpb	-(r0), #40
	beq	20$			; Discard trailing spaces
	sub	r1, r0
	inc	r0
30$:	movb	(r1)+, r3
	cmpb	#'-, r3
	bne	40$
	mov	#40, r3
40$:	movb	r3, (r2)+
	sob	r0, 30$
	movb	#40, (r2)+
	mov	#firqb+26, r1
	mov	#5, r0
50$:	movb	(r1)+, (r2)+
	sob	r0, 50$
	mov	#METT, r1
	movb	(r1)+, r0
60$:	movb	(r1)+, (r2)+
	sob	r0, 60$
	sub	#Date+1, r2
	movb	r2, Date

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

;+
; MrkHdr marks all specified headers.
; Call:	r1, pointer to TEXT record in memeory (File 2).
;-

MrkHdr:	push	<r0, r1, r2, r3, r4, r5>
	mov	r1, r5

	mov	#OutTbP, r3
	mov	#EoOTbP-OutTbP, r2
5$:	clrb	(r3)+
	sob	r2, 5$
	bit	#xEXT, 14(r5)
	beq	10$
	bit	#xEXIN, 14(r5)
	beq	20$

10$:	jmp	400$
	
20$:
	gos	opnlin,	<#FB3>
	
	mov	14(r1), TxtNr
	bne	40$
	tst	16(r1)
	bne	40$
	mov	2(r5), TxtNr
	mov	4(r5), TxtNr+2
	br	50$

40$:	mov	16(r1), TxtNr+2
50$:	inc	r2

300$:	dec	r2
	beq	400$
	
	gos	gtln			; Get next line into TmpStr / r1.
	clr	r0
	bisb	(r1)+, r0
	beq	300$
	
	dec	r0
	beq	300$
	
	movb	(r1)+, r4
	sub	#'A, r4
	asl	r4
	inc	OutTbP(r4)
	br	300$

400$:	pop	<r5, r4, r3, r2, r1, r0>
	rts	pc

;+
; MakeID Makes an message-id: Ex. <353656@ufh.dynas.se>
; call:		r0,	pointer to longword
; Return:	r1,	point at buffer.
; Destroys TmpStr. May change section in KOMRES
;-

MakeID:	push	<r3, r2, r0>		; Must be in this order.
	mov	r1, r3
	mov	#MesID, r2
	push	r2
	clrb	(r2)+			; This is to be length-byte.
	movb	#'<, (r2)+
	mov	(r0)+, r1
	mov	(r0), r0
	call	Num32
10$:	movb	(r1)+, (r2)+
	sob	r0, 10$
	mov	#LibInf, r1
	call	GetAdr
	add	#20, r1
	movb	(r1)+, r0
40$:	movb	(r1)+, (r2)+
	sob	r0, 40$
	movb	#'>, (r2)
	pop	r1
	sub	r1, r2
	movb	r2, (r1)
	pop	<r0, r2, r3>
	rts	pc

;+
; GetFrm Creats a from field.
; Call r0, groupnumber.
;-

GetFrm:	push	<r2, r3>
	mov	#GrpLst, r1
	call	FindCm
	tst	r0
	beq	377$
	gos	GetRec,	<#1, rArg-rStr(r0), #FB1, #Unlock>
	add	#160, r1
	movb	(r1)+, r0
	beq	377$
	mov	#From+1, r2
	mov	#FrmPth, r3
	movb	r0, (r3)+
10$:	movb	(r1), (r2)+
	movb	(r1)+, (r3)+
	sob	r0, 10$
	mov	#LibInf, r1
	call	GetAdr
	add	#20, r1
	movb	(r1)+, r0
20$:	movb	(r1)+, (r2)+
	sob	r0, 20$
	movb	#40, (r2)+
	movb	#'(, (r2)+
	mov	FinPtr, r1
	call	GetAdr
	add	#rStr, r1
	movb	(r1)+, r0
30$:	movb	(r1)+, (r2)+
	sob	r0, 30$
	movb	#'), (r2)
	mov	#From, r1
	sub	r1, r2
	movb	r2, (r1)
	
	tst	(pc)+

377$:	sec
	pop	<r3, r2>
	rts	pc

proc	OutTxt,	<Blk, Pos, Buf>

begin
	push	<r2, r3, r4>
	mov	Buf(r5), r1
	gos	get,	<#3, Blk(r5), r1, #1, #Unlock>
	add	Pos(r5),r1		; Line (down)counter
	cmp	#-1, (r1)+
	beq	48$

42$:	Write	#Ilfr
	jmp	377$

48$:	gos	GetWrd,	<Buf(r5)>
	cmp	#1, r0
	bne	42$

	gos	GetWrd,	<Buf(r5)>
	mov	r0, r2		; # of lines!
	beq	200$

	gos	GetLin,	<Buf(r5)>
	push	r1
	mov	#TmpStr, r1
	movb	(r1)+, r0
	beq	80$
	push	r1
	Write	#SubjT
	pop	r1
50$:	cmpb	#':, (r1)+
	beq	70$
	sob	r0, 50$
	Write	#TmpStr
	br	75$

70$:	dec	r0
	beq	75$
	cmpb	#Spc, (r1)
	bne	71$
	inc	r1
	dec	r0
	beq	75$
71$:	tst	ComntP
	beq	74$

	push	<r0, r1>

	sub	#3, r0
	ble	72$
	cmpb	#'R, (r1)+
	bne	72$
	cmpb	#'e, (r1)+
	bne	72$
	cmpb	#':, (r1)+
	beq	73$
72$:	Write	#Reptxt
	
73$:	pop	<r1, r0>

74$:	call	PrintN

75$:	call	pcrlf
80$:	Write	#zLines
	mov	r2, r1
	dec	r1
	clr	r0
	call	deco16
	call	pcr2lf
	pop	r1
	br	100$

90$:	gos	GetLin,	<Buf(r5)>
	call	OutN

100$:	sob	r2,90$

200$:	tst	(pc)+
377$:	sec
	pop	<r4, r3, r2>
	ret


OutN:	push	r1
	mov	#TmpStr, r1
	movb	(r1)+, r0
	beq	7$
	cmpb	#'@, (r1)		; [r denna rad ett filnamn?
	beq	10$
5$:	call	PrintN			; Skriv ut raden (eller delen av raden)
7$:	call	pcrlf
	br	99$

10$:	inc	r1
	dec	r0
	beq	7$
	call	DispFi

99$:	pop	r1
	rts	pc


DspHd:	push	<r3, r4, r5>

	mov	r5, r1
	gos	opnlin,	<#FB3>
	inc	r2

50$:	dec	r2
	ble	80$
	call	gtln
	clr	r5
	bisb	(r1)+, r5
	beq	50$
	cmpb	(r1), #'+
	bne	55$

	inc	r1
	tst	r4
	bne	70$
	br	50$

55$:	clr	r4
	bisb	(r1)+, r4
	cmpb	r4, #'Z
	bne	60$
	clr	r4
	call	pcrlf
	br	70$

60$:	call	pcrlf
	sub	#'A, r4
	asl	r4
62$:	mov	OutTbl(r4), r1
	bne	64$

	clr	r4
	br	50$

64$:	clr	r4
	bisb	(r1), r4
	call	strout
65$:	mov	#Tmpstr+2, r1

70$:	dec	r5
	beq	50$
	mov	r5, r0
	call	PrintN
	br	50$

80$:	call	pcrlf
99$:	pop	<r5, r4, r3>
	rts	pc	


;+
; GetIRT finds the In-Reply-To-field.
; r1 must point at TEXT-record in memory.
;-

GetIRT:	push	<r2, r3, r4, r5>
	mov	r1, r5
	clrb	ComntP			; Until proved othervise!
	bit	#xKom, 14(r5)
	beq	999$
	mov	24(r5), r2		; Commented letter.
	beq	999$
	gos	GetRec,	<#2, r2, #FB1, #Unlock>
	cmp	#1, (r1)
	bne	999$
	bit	#xEXT, 14(r1)
	beq	999$
	bit	#xEXIN, 14(r1)
	beq	999$
	cmp	#UsNPrs, 12(r1)		; Created by UseNet?
	bne	999$			; No!
	
	mov	#True, ComntP

	gos	opnlin,	<#FB3>
	tst	r2
	beq	999$

10$:	call	gtln
	clr	r4
	bisb	(r1)+, r4
	beq	50$
	cmpb	#'F, (r1)+		;  Message-ID?
	bne	50$

	dec	r4
	beq	999$
	mov	#InRpTo, r2
	movb	r4, (r2)+
20$:	movb	(r1)+, (r2)+
	sob	r4, 20$
	br	999$

50$:	sob	r2, 10$

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

; &

; Transfer text from KIN-file to file 3

proc	xfrtxt,	<hdr>

begin
	push	r1
	mov	hdr(r5), r1
	clr	r2
	bisb	(r1)+, r2
5$:	movb	(r1)+, r0
	call	PutChr
	sob	r2, 5$
	pop	r1
	
	call	copych			; Copy oe char from KIN/FB2/r1 to
	mov	r0, r2			;   file3/FB4/r4
	call	copych
	swab	r0
	bis	r0, r2			; r2 is the number of lines to copy
	beq	40$
10$:	call	copych			; Copy length byte 
	mov	r0, r3
	beq	30$
20$:	call	copych
	sob	r3, 20$
30$:	sob	r2, 10$
40$:	bit	#1, r4			; Odd?
	beq	50$
	call	copych
50$:	ret

; Copy one char from input to output. return in r0

copych:	cmp	r1, #FB2+1000
	blo	10$

	gos	get <#-KIN, , r1, #1,>	; C set if EOF
	bcs	20$
10$:	clr	r0
	bisb	(r1)+, r0
	call	PutChr
20$:	rts	pc
 
; Wildcard open

proc	wopen <chan,name,idx>
	begin
	gos	fsscan <name(r5)>
	call	filerr
	bcs	20$
	movb	#UU.LOK, firqb+fqfun
	mov	idx(r5), firqb+4	; index # for file in directory
	.uuo				; do it!
	cmpb	firqb, #5		; NOSUCH ?
	bne	10$			; Nope - skip forward
	sec
	br	20$
10$:	call	filerr
	bcs	20$
	movb	chan(r5), firqb+fqfil	; Calculate channel # times 2
	asl	firqb+fqfil
	movb	#OPNFQ, firqb+fqfun
	calfip				; Open it!
	call	filerr
	call	savfqb
20$:	ret
		
; FSSCAN - FSS a file name. Put result in FIRQB

proc	fsscan	<n>
	begin
	call	clrfqb
	call	clrxrb
	clr	(r1)
	movb	@n(r5), (r1)		; Length of string
	mov	(r1)+, (r1)+		;  "	"	"
	mov	n(r5), (r1)		; Then the address
	inc	(r1)
	.fss
	ret

; CLOSE indicated channel.

proc	close	<ch>
	begin
	call	clrfqb
	movb	ch(r5), firqb+fqfil
	asl	firqb+fqfil
	calfip
	ret

Proc	Rename	<ext>
	begin
	movb	#RENFQ, Firqb+FqFun
	clr	Firqb+FqFil
	mov	#-1, Firqb+FqSiz
	mov	Firqb+FqNam1, Firqb+FqNam2
	mov	Firqb+FqNam1+2, Firqb+FqNam2+2
	mov	ext(r5), Firqb+FqFlag
	clr	Firqb+FqPFlg
	calfip
	call	Filerr
	ret	

SavFqb:	push	<r2, r1, r0>
	mov	#Firqb, r1
	mov	#FqbBuf, r2
	mov	#20, r0
10$:	mov	(r1)+, (r2)+
	sob	r0, 10$
	pop	<r0, r1, r2>
	rts	pc

RstFqb:	push	<r2, r1, r0>
	mov	#Firqb, r1
	mov	#FqbBuf, r2
	mov	#20, r0
10$:	mov	(r2)+, (r1)+
	sob	r0, 10$
	pop	<r0, r1, r2>
	rts	pc

; Delete (mark for deletion) the file indicated by firqb contents

kill:	movb	#DLNFQ, firqb+fqfun
	calfip
	call	Filerr
	return

quit$:	jmp	$exit

NrDist:	.word	0
DstRec:	.word	0
NrCrTx:	.word	0
FileNr:	.word	0
NrRece:	.word	0
NrFrom:	.word	0
TxtNr:	.blkw0	2
MoreP:	.word	0
NrLine:	.word	0
NrHdrL:	.word	0
EoHdP:	.word	0
HdrIdx:	.word	0
HdrSpc:	.word	0
ComntP:	.word	0

FqbBuf:	.blkw0	20

SubBuf:
Date:	.blkb	200

LinBuf:	.blkb	200

MesId:	.blkb	200

From:	.blkb	200

FrmPth:	.blkb	20

DstNod:	.blkw	100

InRpTo:	.blkb	200

ToBuff:	.blkb	1000

FrBuff:	.blkb	1000

RfBuff:	.blkb	200

HdrStr:	.blkb	200

Buff2:	.blkb	200

HdrPrf:	.word	0
	.word	0
	.word	'C
	.word	'D
	.word	'E
	.word	'F
	.word	'G
	.word	'H
	.word	'I
	.word	'J
	.word	0
	.word	'B
	.word	0
	.word	'M
	.word	'N
	.word	'O
	.word	0
	.word	'Q
	.word	0			; Path:
	.word	'Z

IsAdrF:	.word	-1			; 'A' = From
	.word	-1			; 'B' = To
	.word	-1			; 'C' = Sender
	.word	-1			; 'D' = Bcc
	.word	0
	.word	0
	.word	-1			; 'G' = Reply-To
	.word	0
	.word	0
	.word	-1			; 'J' = Cc
	.word	0
	.word	-1			; 'K' = Newsgroups
	.word	0
	.word	0
	.word	0
	.word	0
	.word	0
	.word	0			; 'Q'
	.word	0			; Path:
	.word	0
	

HeadTb:	.word	FrmHdr
	.word	ToHdr
	.word	SndHdr
	.word	BccHdr
	.word	DatHdr
	.word	MIdHdr
	.word	RToHdr
	.word	IRTHdr
	.word	RecHdr
	.word	CcHdr
SubTb:	.word	SubHdr
	.word	NwGHdr
	.word	LnsHdr
	.word	RefHdr
	.word	KeyHdr
	.word	OrgHdr
	.word	XrfHdr
	.word	FolHdr
	.word	PthHdr
	.word	0

Text	TXHDR,	<<377><377><1><0>>
Text	XTHDR,	<<377><377><2><0><0><0><0><0><0><0><0><0><0><0><0><0>>
Text	KOMAVS,	<"KOM {r f|r tillf{llet avst{ngt."<15><12>>
Text	WlkMes,	<"NewsNet-Server Ver 1.00 ">
Text	OutFil,	<"UN0000.USU">
Text	INFILE,	<"*.USI">
Text	METT,	<" MET">
Text	IlFr,	<"?Illigal text-format">
;Text	MailTo,	<"Mail to:"<Cr><Lf><Cr><Lf>>
text	NoRece,	<"  ?No receiver in KOM">

Text	SubjT,	<"Subject: ">
Text	RepTxt,	<"Re: ">
Text	OrgUfh,	<"UFH-Haninge, Sweden">
Text	PthUfh,	<"Path: ufh!">

Text	FrmHdr,	<"from">
Text	ToHdr,	<"to">
Text	SndHdr,	<"sender">
Text	BccHdr,	<"bcc">
Text	DatHdr,	<"date">
Text	MIdHdr,	<"message-id">
Text	RToHdr,	<"reply-to">
Text	IRTHdr,	<"in-reply-to">
Text	RecHdr,	<"receiver">
Text	CcHdr,	<"cc">
Text	SubHdr,	<"subject">
Text	NwGHdr,	<"newsgroups">
Text	LnsHdr,	<"lines">
Text	RefHdr,	<"references">
Text	OrgHdr,	<"organization">
Text	XrfHdr,	<"xref">
Text	KeyHdr,	<"keywords">
Text	FolHdr,	<"followup-to">
Text	PthHdr,	<"path">

Text	zFrom,	<"From: ">
Text	zTo,	<"To: ">
Text	zSend,	<"Sender: ">
Text	zBcc	<"Bcc: ">
Text	zDate,	<"Date: ">
Text	zId,	<"Message-ID: ">
Text	zRep,	<"Reply-To: ">
Text	zRepTo,	<"In-Reply-To: ">
Text	zRecei,	<"Receiver: ">
Text	zCc,	<"Cc: ">
Text	zNewsG,	<"Newsgroups: ">
Text	zLines,	<"Lines: ">
Text	zRtPth,	<"Return-Path: ">
Text	zStat,	<"Status: ">
Text	zRefer,	<"References: ">
Text	zKeyW,	<"Keywords: ">
Text	zOrg,	<"Organization: ">
Text	zXref,	<"Xref: ">
Text	zFolT,	<"Followup-To: ">

	.even

OutTbl:	.word	zFrom			; 'A'
	.word	zNewsG			; 'B'
	.word	zSend			; 'C'
	.word	0			; 'D'
	.word	0			; 'E'
	.word	0			; 'F'
	.word	zRep			; 'G'
	.word	zRepTo			; 'H'
	.word	0			; 'I'
	.word	0			; 'J'
	.word	zRtPth			; 'K'
	.word	zStat			; 'L'
	.word	zRefer			; 'M'
	.word	zKeyW			; 'N'
	.word	zOrg			; 'O'
	.word	zXref			; 'P'
	.word	zFolT			; 'Q'

OutTbP:	.blkw0	20.
EoOTbP:

	.even

EOKOM:	.End	INIT