.title	Miscellaneous routines

	.inclu	"b:global.mac"
	
.macro	MakMon	MonStr, MonNr, MonDay
	.word	MonDay
	.byte	MonNr
	.ascii	MonStr
.endm

	sect	code
	
; FilErr checks for error and prints an error message in swedish.
; Returns C set if an error was printed cleared otherwise.
;
FilErr:	push	<r0, r1>
	clr	r0
	bisb	firqb, r0
	beq	20$
.if df sweerr	
	mov	#feltab, r1
5$:	tst	(r1)			; End of table?
	beq	15$
	cmp	(r1)+, r0
	beq	11$
	add	#2, r1			; Advance pointer
	br	5$			; Try next one
11$:
	mov	(r1), r1
	call	strout
	br	17$
.endc

15$:	call	ErrPrt			; Change this later!
17$:	call	PCRLF
	br	10$
20$:	tst	(pc)+
10$:	sec
	pop	<r1, r0>
	rts	pc

.if df sweerr
; NOTE: This table must be in the CODE psect. The TEXTS psect may have
; got byte-aligned due to a missing .EVEN in one of the other files
; (to be fixed someday)

feltab:	.word	2, f2$			; Error message table
	.word	4, f4$
	.word	5, f5$
	.word	6, f6$
	.word	8., f8$
	.word	10., f10$
	.word	14., f14$
	.word	0, 0			; End of list

	sect	texts, d

	.even

; (. Translations, word by word, from 'Engelsk-Svensk ordbok' .)

f2$:	.str	<"?Olagligt filnamn">
f4$:	.str	<"?Ingen plats f|r anv{ndaren p} anordningen">
f5$:	.str	<"?Kan inte hitta fil eller konto">
f6$:	.str	<"?Inte en giltig anordning">
f8$:	.str	<"?Anordningen icke tillg{nlig">
f10$:	.str	<"?Skyddskods|vertr{delse">
f14$:	.str	<"?Anordningen h{ngd eller skrivskyddad">

	.even

.endc
	sect	code


ADDHDL:	REPARS	#2, #G30
	bcs	999$
	mov	Found(r0), r1
	call	GetAdr
	call	@(r1)
999$:	rts	pc

SUBHDL:	REPARS	#2, #G172
	bcs	999$
	mov	Found(r0), r1
	call	GetAdr
	call	@(r1)
999$:	rts	pc

; PutLst, Get1st and PutChr are extracted from COMPOS (to avoid
; being overlayed).

PutLst:
	clr	r0
	bit	#1, r4			; Odd address?
	beq	10$
	call	PutChr			; Evenize

10$:	sub	#FB4, r4
	beq	20$
	gos	Put <#3, , #FB4>

20$:
	mov	FB4-2, FB4
	mov	r4, FB4+2
	gos	put <#3, #1, #FB4>

	mov	#3, r0
	call	releas
	rts	pc
	
Get1st:
	gos	getRec <#3, #1, #FB4,>	; First block.
	mov	#3, r0
	call	exlock			; Lock it

	mov	(r1), -(r1)
	mov	(r1)+, r3
	mov	FB4+2, r4		; First free pos. (Pos in block)
	beq	100$
	gos	GetRec <#3, r3, r1,>
100$:	rts	pc

PutChr:
	movb	r0, (r4)+
	cmp	r4, #FB4+1000
	blo	100$
	gos	put <#3, ,#FB4>
	mov	#FB4-2, r4
	inc	(r4)+
100$:	rts	pc

;+ ExistP checks if a certain text exists.
; Data passed:	 r0, Pointer to a file buffer to be used temporary.
;		 r1, Pointer to a long textnumber.
; Data returned: C set if the text is nowhere to be found.
;-
ExistP:	push	r2
	mov	r1, r2
	mov	#LibInf, r1
	call	GetAdr
	cmp	2(r2), 4(r1)		; High part.
	bhi	3$
	blo	25$
	cmp	(r2), 2(r1)		; Low part.
	blos	25$
3$:	write	#Notext
	br	30$

25$:	tst	(pc)+
30$:	sec
	mov	r2, r1
	pop	r2
	rts	pc

CATA:
	push	r1
	mov	#xrb, r1		; Cancel All Type-ahead
	mov	#7, (r1)+
	clr	(r1)
	mov	(r1)+, (r1)+
	clrb	(r1)+
	movb	#2, (r1)+		; 2=TTYHND
	clr	(r1)
	.spec
	pop	r1
	rts	pc
	

;+	GetHdr gets the header of the physical text # in r0 to TmpStr
; Data passed:	 r0, Physical text #.
;		 r1, Pointer to a file buffer.
; Data returned: Nothing.
;+
GetHdr:	
	push	r1
	gos	GetRec <#2,r0,r1,#Unlock>
	mov	r1, r0
	pop	r1
	clr	-2(r1)
	
;+ Do a optimised get-header
;
; Data passed:	r0, pointer to a TEXT record in memory
; 		r1, Pointer to file buffer for file 3. This routine uses
;		    the value at -2(r1) so it must be cleared if the buffer
;		    doesn't contain anyting useful
;
; Data returned: TmpStr, the header string
;-
fixhdr:
	push	<r0, r1, r2, r3, r4,r5>
	mov	r1, r2
	push	22(r0)			; Save pos. in block.
	gos	TryRec <#3,20(r0),r2,#Unlock>
	add	(sp)+, r1
	cmp	#-1, (r1)+		; CheckWord (-1)
	beq	20$

10$:	clrb	Tmpstr			; No lines -> return TMPSTR empty
	br	40$
	
20$:	gos	GetWrd,	<r2>		; Get object-typ-word
	cmp	#1, r0			; 1 = TEXT.
	bne	10$
	
	gos	GetWrd,	<r2>
	tst	r0
	beq	10$

	gos	GetLin,	<r2>		; Get 1'st line.

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

50$:	gos	Get <#3, ,r2,#1,#Unlock>
	mov	r2, r1
	rts	pc

;+	CnvLet 
; Data passed:	 r0, Pointer to a file buffer to be used temporarily (??)
;		 r1, Pointer to a double-word logical text number
; Data returned: C clear if the text existed. Set otherwise
;		 r0, Physical text number (if C clear. Otherwise random)
;		 r1, Same as data passed.
;-
CnvLet:	push	r1
	mov	2(r1), -(sp)
	mov	(r1), -(sp)
	mov	sp, r1
	call	ExistP
	bcs	20$
	call	FysTxt
	tst	r0
	bne	10$
	push	r1
	write	#Txt.no	
	pop	r1
	call	Deco32
	write	#Erased
	br	20$
10$:	tst	(pc)+
20$:	sec
	mov	(sp)+, (sp)+
	pop	r1
	rts	pc
	
Proc	shortn <str,buf,len>
	begin
	push	<r2, r3, r4>	
	mov	str(r5), r2
	mov	buf(r5), r1
	clr	r0
	clr	r4
	bisb	(r2)+, r4

10$:	mov	len(r5), r3
	cmp	r3, r4			; r4 will contain # of chars left.
	bhis	30$
	call	100$
	sub	r3, r4
	movb	r3, (r1)+
20$:	movb	(r2)+, (r1)+
	sob	r3, 20$
	inc	r0
	br	10$

30$:	sub	r3, r4
	add	r4, r3
	movb	r3, (r1)+
	beq	50$
40$:	movb	(r2)+, (r1)+
	sob	r3, 40$
	inc	r0

50$:	pop	<r4, r3, r2>
	Ret

100$:	push	<r0, r2, r3>
	mov	#10, r0
	add	r3, r2
105$:	cmpb	-(r2), #40
	bhi	110$
	mov	r3, (sp)
	br	120$

110$:	dec	r3
	sob	r0, 105$

120$:	pop	<r3, r2, r0>
	rts	pc

;+ AccLet checks to see if I have the right to see a certain text.
; Data passed:	r1, Pointer to TEXT node in memory
; Data returned: C set if accesses were denied..
; FB3 and FB4 are destroyed 
;-
AccLet:	push	<r0, r1, r2, r3, r4>
	bit	#AdmPrv!AbsPrv, KSW	; Am I Adm?
	bne	888$			; Ok => to 20$
	
	mov	r1, r3			; Save r1 for future use
	clr	r4			; exit flag when multireceivers.

	clr	FB3-2
	clr	FB4-2

	cmp	Me, 12(r3)		; Did I write it?
	beq	888$

10$:	cmp	Me, 16(r3)		; Am I (one of) the receiver(s)?
	beq	888$			; If so - exit at 20$

	mov	16(r3), r0		; Get receiver #
	mov	#GrpLst, r1
	call	FindCm
	tst	r0			; Unperson?
	beq	20$

	bit	rPri1-rStr(r0), #11	; A Person or NetPerson?
	bne	20$			; Yes - Check for additional receivers

	gos	tryrec <#1, rArg-rStr(r0), #FB4, #Unlock>
	call	AccMet			; Check for accessability of meeting
	bcc	888$			; Ok, you can take your access....
	
20$:	bit	#xMulR, 14(r3)		; Multiple receivers?
	beq	999$			; No - to 30$

	mov	34(r3), r0
	beq	999$			; Hmpff!

	tst	r4
	beq	25$

	cmp	r0, r4
	bne	30$
	br	999$			; All is done!!!

25$:	mov	r0, r4

30$:	gos	tryrec <#2, r0, #FB3, #unlock>
	mov	r1, r3
	br	10$

888$:	tst	(pc)+
999$:	sec
1000$:	pop	<r4, r3, r2, r1, r0>
	rts	pc
	
	
;+ AccMet checks if I (Me) am a member a certain meeting.
; Data passed:	 r1, pointer to a meeting (in memory)
; Data returned: C set if I was not a member.
;-
AccMet:	
	push	<r0, r1, r2, r3, r4>
	clc
	bit	#AdmPrv!AbsPrv, KSW
	bne	300$

	cmp	(r1), #3		; Person?
	bne	5$
	cmp	Me, 6(r1)		; Myself?
	bne	40$
30$:	tst	(pc)+
40$:	sec
	br	300$

5$:	bit	#xOPN, 16(r1)		; Open meetings are always "public"
	bne	30$	
	sub	#1002, sp
	mov	sp, r2
	clr	(r2)+
	mov	r2, -(sp)
	add	#1000, (sp)		; Prepare for return

	mov	24(r1), r4		; Number of members
	beq	200$			; No members - no good.
	mov	26(r1), r3
10$:	gos	tryrec <#1, r3, r2, #UnLock>
	tst	(r1)+
	mov	(r1)+, r3
	tst	(r1)+
	mov	#75, r0
	sub	r0, r4
	bpl	20$
	add	r4, r0
20$:	cmp	Me, (r1)+
	beq	100$
	sob	r0, 20$
	tst	r4
	bgt	10$
	br	200$

100$:	tst	(pc)+

200$:	sec
	mov	(sp), sp
300$:	pop	<r4, r3, r2, r1, r0>
	rts	pc

proc	WrToP,	<Grp, Rec, Flag>

begin
	push	<r0, r1, r2>
	mov	Grp(r5), r0
	mov	#GrpLst, r1
	call	FindCm
	tst	r0
	beq	999$			; Receiver is no more...

	bit	#AdmPrv!AbsPrv, KSW
	bne	888$			; You got every thing you want!

	mov	rPri1-rStr(r0), r1

	cmp	#1, r1			; PERSON?
	beq	888$			; You can always write to a person.

	cmp	#2, r1			; M\TE (newsgroup)?
	bne	200$

	gos	GetRec,	<#1, rArg-rStr(r0), rec(r5), #Unlock>

	cmp	Me, 10(r1)
	beq	888$			; You can always write to your
					;  own meetings
	bit	#xWP, 16(r1)		; Write protected?
	beq	888$			; No, you may go on....
	br	999$			; Yes, no access.

	; Aha, you want to send it to an external net. We shall se...

200$:	bit	#NetNam, USW
	beq	999$			; You got to have a internetname...
	mov	MyNtRt, r2
	beq	999$			; Oho no, not you...

	gos	GetRec,	<#1, rArg-rStr(r0), rec(r5), #UnLock>
	bit	#xNWP, 16(r1)
	bne	999$			; Writeprotected => No access!
	tst	flag(r5)
	beq	210$
	bit	#xNCl, 16(r1)		; Used by "Add To Distr.-list"
	bne	999$
210$:	bit	r2, 36(r1)
	beq	999$			; Sorry, no access!

888$:	tst	(pc)+			; Access granted!

999$:	sec				; Access NOT granted!

	pop	<r2, r1, r0>
	ret

;+	This routine get HIGH for a specified group.
; Data passed:	 r0, Group whose HIGH is to be got
; Data returned: r0, High
;
GetHig:	push	r1
	push	CurSek
	mov	#GrpLst, r1
10$:	call	getAdr
	cmp	(r1), r0
	beq	30$
20$:	mov	rNxt(r1), r1
	bne	10$
	clr	r0
	br	99$
	
30$:	tst	rPri1(r1)
	beq	20$
	mov	rHigh(r1), r0
99$:	pop	r1
	call	PopSek
	pop	r1
	rts	pc
	
;+	GetMe gets Me.
; Data passed:	 info (see the PROC declaration below)
; Data returned: r1, points to filebuffer.
;-
Proc	GetMe 	<buf>
	begin
	mov	#Unlock, r1
$getme:	push	r0
	gos	getrec <#1, MyRec, buf(r5), r1>
	pop	r0
	Ret

Proc	LockMe	<buf>
	begin
	mov	#Lock, r1
	br	$getme

	sect	texts,d

;+
; CnvDat tar en str[ng och returnerar ett datum i internformat.
; Till}ten form: 880116, 88.01.16 eller 16-JAN-88.
; Anrop:	r0, L{ngden av str{ngen.
;		r1, Pekare p} str{ngen.
;
; Return:	r0, Datum i internformat.
;		carry:n sat om felakigt format.
;-

CnvDat:	push	<r1,r2,r3,r4,r5>
	mov	r0, r3
	mov	#PStr2, r2
	gos	CVT$$,	<r1, r2, r3, #2!4>
	clr	r1
	bisb	(r2)+, r1
	cmp	#6, r1
	beq	20$
	cmp	#8., r1
	beq	20$
	cmp	#9., r1
	beq	200$
10$:	Write	#WroFrm
	br	9000$

20$:	call	TwoDig
	bcs	10$
	mov	r0, r3			; ]r
	call	SepChk
	bcs	10$
	call	TwoDig
	bcs	10$
	mov	r0, r4			; M}nad
	call	SepChk
	bcs	10$
	call	TwoDig
	bcs	10$
	mov	r0, r5			; Dag
	br	1000$

200$:	call	TwoDig
	bcs	10$
	mov	r0, r5
	call	SePChk
	bcs	10$
	mov	#Mounth, r0
	tst	(r0)+
210$:	movb	(r0)+, r4
	push	<r0,r2>
	cmpb	(r2)+, (r0)+
	bne	230$
	cmpb	(r2)+, (r0)+
	bne	230$
	cmpb	(r2)+, (r0)+
	beq	240$
230$:	pop	<r2,r0>
	add	#3, r0
	tst	(r0)+
	bne	210$
	br	10$
240$:	cmp	(sp)+, (sp)+
	call	SepChk
	bcs	10$
	call	TwoDig
	bcs	10$
	mov	r0, r3
	

1000$:	cmp	#2, r4
	bhis	1010$
	bit	#3, r3
	bne	1010$
	inc	r5			; Skott}r.
1010$:	sub	#70., r3
	mul	#1000., r3
	add	r5, r3
	mov	#Mounth, r1
	mov	(r1)+, r5
1020$:	mov	(r1), r0
	cmpb	(r1), r4
	beq	1030$
	cmp	(r1)+, (r1)+
	mov	(r1)+, r5
	bne	1020$
	br	10$
1030$:	add	r5, r3
	mov	r3, r0
	tst	(pc)+
9000$:	sec
	pop	<r5,r4,r3,r2,r1>
	rts	pc

TwoDig:	push	<r3, r4>
	clr	r3
	mov	#2, r4
10$:	movb	(r2)+, r0
	sub	#'0, r0
	bmi	99$
	cmp	#9., r0
	blo	99$
	mul	#10., r3
	add	r0, r3
	sob	r4, 10$
	mov	r3, r0
	tst	(pc)+
99$:	sec
	pop	<r4,r3>
	rts	pc

SepChk:	push	r3
	cmp	#6, r1
	beq	99$
	cmpb	#'., (r2)
	beq	20$
	cmpb	#'-, (r2)
	bne	100$
20$:	inc	r2
99$:	tst	(pc)+
100$:	sec
	pop	r3
	rts	pc

text	WroFrm,	<"Felaktigt format p} datumet."<cr><lf><cr><lf>>
text	Notext,	<"Texten existerar inte."<cr><lf><cr><lf>>
text	Txt.no,	<"(Text ">
text	Erased,	<") {r utpl}nad."<cr><lf><cr><lf>>
Text	G30,	<"Vad vill du ADDERA">
Text	G172,	<"Vad vill du SUBTRAHERA">

	.even

	.radix	10

Mounth:	MakMon	"JAN", 1, 0
	MakMon	"FEB", 2, 31
	MakMon	"MAR", 3, 59
	MakMon	"APR", 4, 90
	MakMon	"MAJ", 5, 120
	MakMon	"MAY", 5, 120
	MakMon	"JUN", 6, 151
	MakMon	"JUL", 7, 181
	MakMon	"AUG", 8,  212
	MakMon	"SEP", 9,  243
	makMon	"OKT", 10, 273
	MakMon	"OCT", 10, 273
	MakMon	"NOV", 11, 304
	MakMon	"DEC", 12, 334
	.word	0

	.even

	.end