.enabl	lc
	.dsabl	gbl
	.title	read
;++
;
; Mail reader for Digby's Bitpile.
;
; By John Wilson, 18-Apr-86.
;
; Must be assembled with PREFIX.MAC
;
;--
	.mcall	exit$s
;
msgcnt=	20	;offset of msg count in user record
msgppn=	22	;offset of PPN to send mail to in user record
;
bell=	7	;bell
lf=	12	;line feed
cr=	15	;carriage return
esc=	33	;escape
;
firqb=	402	;file request queue block
xrb=	442	;transfer request block
calfip=	emt	;call to file processor
opnfq=	2	;subfunc to open a file
crefq=	4	;... to create and open a file
.read=	emt+2	;read a record
.write=	emt+4	;write a record
.sleep=	emt+10	;time delay
.peek=	emt+12	;peek monitor core
job=	1006	;addr of our job # in monitor core
.date=	emt+34	;get system date/time
.uuo=	emt+66	;FIP calls (unimplemented user operation)
uu.cnv=	20.	;subfunc to convert date and time to ASCII
;
	.macro	type	str,len
	jsr	r5,print
.if nb <len>
	.word	len
.iff
	.word	l.'str
.endc
	.word	str
	.endm
;
read:	type	crlfs		;crlf
	mov	#job,xrb	;addr
	.peek			;get job #
	clr	r3		;clear high byte
	bisb	xrb,r3		;get job # *2
; get loser's name from NAMEjj.TMP
	call	clrfrq		;clear out the firqb
	asr	r3		;/2=job #
	clr	r2		;sxt
	div	#10.,r2		;separate digits of job #
	mov	r2,r1		;copy high digit
	mul	#50,r1		;shift left (rad50)
	add	r3,r1		;add digits together
	movb	#opnfq,firqb+3	;func=open file for input
	movb	#2,firqb+4	;on channel 1
	mov	#firqb+10,r2	;point at filename
	mov	#^RNAM,(r2)+	;name='NAMEjj.TMP'
	add	#^RE00,r1	;cvt job
	mov	r1,(r2)+	;put in firqb
	mov	#^RTMP,(r2)
	calfip			;open the file
	tstb	firqb		;successful?
	beq	10$		;yes, skip
	type	anon		;anonymous losers can't receive mail
	exit$s			;die
10$:	mov	#xrb,r0		;point at xrb
	mov	#30,(r0)+	;read 12. words
	clr	(r0)+		;(nothing read yet)
	mov	#name,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next (first) block
	clr	(r0)+		;(not applicable)
	clr	(r0)		;no modifiers
	.read			;do it
	call	close1		;close the file
	mov	#loser,r0	;pt at name
	call	lookup		;look ourself up
	mov	r2,blk		;save block #
	mov	r3,addr		;and address
	tst	msgcnt(r3)	;any messages?
	bne	next		;yes, skip
	type	nomail		;no mail
	type	name,12.	;username
	type	crlfs,3		;cr lf lf
	exit$s			;die
;
next:	; retrieve next message
	mov	#mailfi,r2	;point at mail file name
	call	openw		;open it, get write access
;	bcs	...		;error, bomb
	mov	#1,r5		;blk #
10$:	mov	#rcpt,r4	;point at buffer
	mov	#xrb,r0		;point at xrb
	mov	#1000,(r0)+	;read 1 blk
	clr	(r0)+		;none yet
	mov	r4,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next blk
	clr	(r0)+		;(unused)
	clr	(r0)		;no modifiers
	.read			;do it
	mov	#loser,r0	;point at losername
	tst	(r0)		;empty block?
	beq	35$		;yes, skip
	mov	#4,r1		;# words to compare
20$:	cmp	(r0)+,(r4)+	;compare a word
	bne	30$		;not the same, skip
	sob	r1,20$		;loop
	mov	(r4)+,r1	;get # blks in msg
	dec	r1		;1 block?
	beq	40$		;yep
	ash	#9.,r1		;=byte count
	mov	#xrb,r0		;point at xrb
	mov	r1,(r0)+	;byte count
	clr	(r0)+		;none yet
	mov	#rcpt+1000,(r0)+ ;addr
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next blk(s)
	clr	(r0)+		;(unused)
	clr	(r0)		;no modifiers
	.read			;do it
	br	45$		;skip
30$:	; skip to next message
	; don't worry about eof, there MUST be a match, right?
	dec	r1		;correct
	asl	r1		;*2
	add	r1,r4		;skip to end of name
	add	(r4),r5		;bump to next msg
	br	10$		;try again
35$:	; skip to next blk (this one was blank)
	; same deal as above
	inc	r5		;next block
	br	10$		;try again
40$:	; the entire msg has been read
	add	#buf-rcpt,r1	;skip header (rad50 may be negative)
45$:	add	#rcpt,r1	;point at last block
50$:	tstb	(r1)+		;find end in last blk
	bpl	50$		;this isn't it
	dec	r1		;got it, back up
	mov	#buf,r4		;point at buffer
	sub	r4,r1		;=length
	; mark the blocks as free in the file
	mov	numblk,r3	;# blks to free
	mov	r3,r2		;copy
	ash	#9.,r2		;=byte count
60$:	mov	(r4),-(sp)	;save
	clr	(r4)		;mark as free
	add	#1000,r4	;skip to next blk
	sob	r3,60$		;loop
	mov	#xrb,r0		;point at xrb
	mov	r2,(r0)+	;byte count
	mov	r2,(r0)+	;(again)
	mov	#buf,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	mov	r5,(r0)+	;starting blk #
	clr	(r0)+		;(not used)
	clr	(r0)		;no modifiers
	.write			;free the blks
	call	close1		;quick!  (don't wedge other users)
	; restore the words we zapped
	mov	numblk,r3	;get blk count again
70$:	sub	#1000,r4	;back up
	mov	(sp)+,(r4)	;restore
	sob	r3,70$		;loop
	mov	r1,90$		;poke length
80$:	jsr	r5,print	;print the msg (at last!)
90$:	.word	0,buf
100$:	type	replyq		;ask what they want to do
	mov	#kbbuf,r0	;point at buffer
	call	rdline		;get their response
	mov	r0,r2		;save
	type	crlfs		;crlf
	mov	r2,r0		;restore
110$:	movb	(r0)+,r1	;get a char
	beq	donext		;blank line, skip
	cmp	r1,#40		;blank or ctrl char?
	blos	110$		;yep, ignore it
	bic	#40,r1		;cvt to upper case if lower
	cmp	r1,#'A		;again?
	beq	80$		;yep, show it again
	cmp	r1,#'R		;reply?
	beq	reply		;yes, do it
	cmp	r1,#'N		;next?
	beq	donext		;yep
	type	what		;complain
	br	100$		;try again
;
donext:	; dec msg count, get next
	mov	#usrlst,r2	;point at loser list filename
	call	openw		;open it, get write access
	mov	#xrb,r0		;pt at xrb
	mov	#1000,(r0)+	;read 1 blk
	clr	(r0)+		;none yet
	mov	#buf,(r0)+	;buf addr
	mov	#2,(r0)+	;channel 1
	mov	blk,(r0)+	;blk #
	clr	(r0)+		;(unused)
	clr	(r0)		;no modifiers
	.read			;read our entry
	mov	addr,r3		;get addr of our entry
	dec	msgcnt(r3)	;dec msg count
	mov	#xrb,r0		;pt at xrb
	mov	#1000,(r0)+	;write 1 blk
	tst	(r0)+		;(1000 still there from .READ)
	mov	#buf,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	tst	(r0)+		;(blk still there)
	clr	(r0)+		;(unused)
	clr	(r0)		;no modifiers
	.write			;write the block back
	call	close1		;close the file
	tst	msgcnt(r3)	;anything left?
	beq	10$		;no, skip
	 jmp	next		;yes, get it
10$:	type	nomore		;that's it
	exit$s			;die
;
reply:	; reply to the msg
	mov	#datbuf,r5	;pt at buf
	mov	#datek,r4	;look for 'Date:'
	call	parse		;do it
	bcc	10$		;got it
	clrb	(r5)		;no date
	br	20$		;skip
10$:	movb	(r2)+,(r5)+	;left-justify
	bne	10$		;loop
20$:	mov	#sbjct,r5	;pt at buf
	mov	#subk,r4	;look for 'Subject:'
	call	parse		;do it
	bcc	30$		;got it, skip
	clrb	(r5)		;no subject
	br	40$		;skip
30$:	movb	(r2)+,(r5)+	;left-justify
	bne	30$		;loop
40$:	mov	#kbbuf,r5	;point at buffer
	mov	#fromk,r4	;look for 'From:'
	call	parse		;do it
	bcc	50$		;no prob, skip
	type	noret		;no return address
	br	90$		;skip
50$:	movb	(r2)+,(r5)+	;left-justify in buffer
	bne	50$		;(loop)
60$:	mov	#kbbuf,r0	;point at source buf
	mov	#rcpt,r5	;dst buf
	call	cvr50		;cvt to rad50
	bcc	100$		;no prob, skip
	type	badadr		;bad address
	mov	#kbbuf,r0	;point at it
70$:	tstb	(r0)+		;find end
	bne	70$
	movb	#cr,-1(r0)	;add cr,lf,lf
	movb	#lf,(r0)+
	movb	#lf,(r0)
	sub	#kbbuf-1,r0	;find length
	mov	r0,80$		;poke
	jsr	r5,print	;print it
80$:	.word	0,kbbuf
90$:	type	to		;prompt 'To: '
	mov	#kbbuf,r0	;point at buf
	call	rdline		;get new addr
	br	60$		;cvt to rad50
100$:	mov	#rcpt,r0	;point at recipient
	call	lookup		;look up name
	bcc	110$		;no prob, skip
	type	nosuch		;no such user
	br	90$		;try again
110$:	mov	msgppn(r3),usrppn ;save user ppn
	tstb	sbjct		;is there a subject already?
	bne	header		;yes, use it
	type	subj		;'Subject: '
	mov	#sbjct,r0	;point at buffer
	call	rdline		;get response
;
header:	; make the header
; From: LOSERNAME
	mov	#buf,r5		;point at buffer
	mov	#from,r0	;'From: '
	call	copy
	mov	#name+12.,r1	;pt at end of name
10$:	cmpb	#' ,-(r1)	;trim trailing blanks
	beq	10$
	sub	#name-1,r1	;find length
	mov	#name,r0	;point at name
20$:	movb	(r0)+,(r5)+	;copy a byte
	sob	r1,20$		;loop
	call	crlf
; [Subject: subject]
	tstb	sbjct		;do we have a subject?
	beq	30$		;no, bag the line
	mov	#subj,r0	;'Subject: '
	call	copy
	mov	#sbjct,r0	;copy the string
	call	copy
	call	crlf
; Date: DD-Mmm-YY, HH:MM xM
30$:	mov	#date,r0	;point at date
	call	copy		;copy to buffer
	.date			;get date, time
	movb	#uu.cnv,firqb+3	;func=convert date/time
	mov	xrb,firqb+4	;copy date
	clr	firqb+6		;use system default format
	mov	xrb+2,firqb+22	;copy time
	clr	firqb+24	;use default
	.uuo			;convert date/time to ASCII
	mov	#firqb+10,r0	;point at date
	call	copy		;copy it
	movb	#',,(r5)+	;add 2 spaces
	movb	#' ,(r5)+
	mov	#firqb+26,r0	;point at time
	call	copy		;copy it
	call	crlf		;add a crlf
; [In-reply-to: Your msg of DD-Mmm-YY, HH:MM xM]
	tstb	datbuf		;do we have a date?
	beq	40$		;no
	mov	#inrep2,r0	;'In-reply-to: Your msg of '
	call	copy		;copy it
	mov	#datbuf,r0	;point at date
	call	copy		;copy it
	call	crlf
; To: LOSERNAME
40$:	mov	#to,r0		;'To: '
	call	copy
	mov	#rcpt,r0	;point at name
	call	pr50		;put in buf
	call	crlf		;crlf
; end of header
	call	crlf		;blank line
; the msg itself...
	type	msg		;'Msg:'
	clr	r4		;we haven't warned them yet
50$:	cmp	r5,#bufend-<2*kbbufl> ;space for 2 full lines?
	blos	60$		;yep
	type	lastln		;no, this has to be the last one
	com	r4		;set flag
60$:	mov	r5,r0		;point
	call	rdline		;read a line
	bcs	80$		;^Z, skip
	add	r1,r5		;update ptr
	cmp	r2,#esc		;did they end with escape?
	bne	70$		;no
	type	crlfs		;go to begn of line
	tst	r1		;blank line?
	beq	80$		;yes
	call	crlf		;no, end it
	br	80$		;skip
70$:	call	crlf		;add a crlf
	tst	r4		;did we say no more?
	beq	50$		;no, loop
80$:	call	crlf		;add a blank line
	; now actually send the msg
	mov	usrppn,r4	;get PPN
	bne	notbbs		;non-zero, send to their account
;
sndbbs:	; send to BBS user
	movb	#377,(r5)+	;mark end of msg
	sub	#rcpt,r5	;find length
	add	#777,r5		;round to next blk
	bic	#777,r5		;whee!
	mov	#mailfi,r2	;point at mail filename
	call	openw		;open for output
	mov	firqb+16,r4	;get file size
	mov	r5,r3		;copy size
	ash	#-9.,r3		;find # blks
	mov	r3,numblk	;poke
	clr	r2		;curr # in a row
10$:	mov	#xrb,r0		;point at xrb
	mov	#2,(r0)+	;len=1 word
	clr	(r0)+		;nothing yet
	mov	#flag,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next block
	clr	(r0)+		;(not used)
	clr	(r0)		;no modifiers
	.read			;read the first word of the blk
	tst	flag		;is it empty?
	beq	20$		;yep, count it
	clr	r2		;zap count, if any
	br	30$		;go do next block
20$:	inc	r2		;bump count
	cmp	r2,r3		;enough?
	blo	30$		;no, do next block
	mov	xrb+10,r1	;get blk #
	dec	r3		;dec count
	sub	r3,r1		;find blk #
	br	40$		;skip
30$:	sob	r4,10$		;loop
	mov	xrb+10,r1	;get last blk #
	inc	r1		;point at 1st blk after end
40$:	mov	#xrb,r0		;yep, pt at xrb
	mov	r5,(r0)+	;buf len
	mov	r5,(r0)+	;(again)
	mov	#rcpt,(r0)+	;starting addr
	mov	#2,(r0)+	;channel 1
	mov	r1,(r0)+	;point at first free blk
	clr	(r0)+		;(not used)
	clr	(r0)		;no modifiers
	.write			;write the msg
	call	close1		;close the file
	mov	#usrlst,r2	;point at loser list filename
	call	openw		;open it, check for write access
	mov	#xrb,r0		;point at xrb
	mov	#1000,(r0)+	;len=1 blk
	clr	(r0)+		;nothing yet
	mov	#buf,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	mov	blk,(r0)+	;block
	clr	(r0)+		;(unused)
	clr	(r0)		;no modifiers
	.read			;read the entry for the recipient
	mov	addr,r0		;point at mail count
	inc	msgcnt(r0)	;bump msg count
	mov	#xrb,r0		;pt at xrb
	mov	#1000,(r0)+	;len=1 blk
	tst	(r0)+		;(1000 still there from .READ)
	mov	#buf,(r0)+	;addr
	mov	#2,(r0)+	;channel 1
	tst	(r0)+		;(blk is still there)
	clr	(r0)+		;(unused)
	clr	(r0)		;no modifiers
	.write			;update
	br	closf		;close file
;+
;
; Write the message onto MAIL.BOX in their acct.
; (PPN comes in r4)
;
;-
notbbs:	sub	#buf,r5		;find offset
10$:	bit	#777,r5		;block full?
	beq	20$		;yep
	clrb	buf(r5)		;not yet
	inc	r5
	br	10$		;loop
20$:	mov	#opnfq,r3	;start with an open
30$:	call	clrfrq		;zap the firqb
	movb	r3,firqb+3	;func=open for output
	movb	#2,firqb+4	;channel 1
	mov	#firqb+6,r1	;point
	mov	r4,(r1)+	;PPN
	mov	#^RMAI,(r1)+	;'MAIL.BOX'
	mov	#^RL  ,(r1)+
	mov	#^RBOX,(r1)
	mov	#100002,firqb+22 ;mode=open for append
	calfip			;open the file
	mov	firqb,r0	;error?
	bne	40$		;yep, bag
	bit	#2000,firqb+24	;do we have write access?
	beq	60$		;yep, good
	call	close1		;no, close it
	mov	#3,xrb		;wait 3 seconds
	.sleep
	br	30$		;try again...
	; it might be nice to print a msg
	; on the first time through the loop...
40$:	cmpb	firqb,#5	;"?Can't find file or account" ?
	bne	50$		;no, skip
	mov	#crefq,r3	;this time create it
	br	30$		;loop
50$:	;;;;;; error opening file - print msg and bag
60$:	mov	#xrb,r1		;point at xrb
	mov	r5,(r1)+	;length
	mov	r5,(r1)+
	mov	#buf,(r1)+	;addr
	mov	#2,(r1)+	;channel 1
	clr	(r1)+		;next block(s)
	clr	(r1)+		;(unused)
	clr	(r1)		;no modifiers
	.write			;do it
	;br	closf		;close the file
;
closf:	; finish up
	call	close1		;close the file
	mov	#buf,r5		;point at buffer
	mov	#queued,r0	;'Queued: '
	call	copy
	mov	#rcpt,r0	;point at recipient
	call	pr50		;add name
	call	crlf		;crlf
	movb	#lf,(r5)	;final lf
	sub	#buf-1,r5	;find length
	mov	r5,qlen		;poke
	jsr	r5,print	;print msg
qlen:	.word	0,buf
	jmp	donext		;go get next incoming msg
;+
;
; Parse a field off of the header from the
; current (incoming) msg.
;
; On entry:
; r5	buffer to put the field (including keyword)
; r4	keyword to find (all LOWER case) (ASCIZ)
;
; Returns C=1 if keyword not found.
;
; Otherwise,
; r5	unchanged
; r4	unchanged
; r2	ptr to value of field
;
;-
parse:	mov	#buf,r3		;point at buffer
10$:	mov	r5,r2		;copy ptr
20$:	movb	(r3)+,r0	;get a char
	bmi	70$		;end of msg!  (must be garbled)
	cmp	r0,#cr		;end of line?
	beq	30$		;yes
	movb	r0,(r2)+	;copy into buf
	br	20$		;loop
30$:	cmp	r2,r5		;blank line?
	beq	70$		;yes, end of header, not found
	clrb	(r2)		;mark end
	cmpb	(r3)+,#lf	;skip line feed
	bne	70$		;it wasn't a line feed, garbled
	mov	r5,r2		;reinit ptr
	mov	r4,r1		;copy
40$:	movb	(r2)+,r0	;get a char
	beq	10$		;ack!
	cmp	r0,#':		;end of keyword?
	beq	50$		;yep, check for end of source
	bis	#40,r0		;no, convert to lower case
	cmpb	r0,(r1)+	;equal?
	bne	10$		;no, skip to next field
	br	40$		;loop
50$:	tstb	(r1)		;end of word?
	bne	10$		;no, no match
60$:	movb	(r2)+,r0	;yes, skip blank(s)
	beq	70$		;blank line, never mind
	cmp	r0,#40		;blank or ctrl char?
	blos	60$		;yes, ignore
	dec	r2		;no, back up
	clc			;got it
	rts	pc
70$:	sec			;not found
	rts	pc
;+
;
; Look up loser record in BBUSER.DAT
; Return block, addr of entry r2, r3.
; Takes ptr to .rad50 username in r0.
; Returns C=1 if not found.
;
;-
lookup:	mov	r0,-(sp)
	call	clrfrq		;clear the firqb
	movb	#opnfq,firqb+3	;func=open file for input
	movb	#2,firqb+4	;on channel 1
	mov	#firqb+6,r1	;point at filename
	mov	#bbsppn,(r1)+	;filename='devn:[p,pn]BBUSER.DAT'
	mov	#^RBBU,(r1)+
	mov	#^RSER,(r1)+
	mov	#^RDAT,(r1)
	mov	#120000,firqb+22 ;/RONLY
.iif ne <bbsdev>, mov #bbsdev,firqb+30
.iif ne <bbsunt>, mov #bbsunt,firqb+32
	calfip			;open the file
	tstb	firqb		;error?
	bne	70$		;yes (oops!)
	mov	firqb+16,r5	;get file size
10$:	; look up loser's record in BBUSER.DAT
	mov	#8.,r4		;# of records per block
	mov	#buf,r3		;point at buffer
	mov	#xrb,r0		;point at xrb
	mov	#512.,(r0)+	;read one block
	clr	(r0)+		;nothing read yet
	mov	r3,(r0)+	;into @#buf
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next block
	clr	(r0)+		;(KB wait time)
	clr	(r0)		;(modifier bits)
	.read			;read the block
20$:	mov	#4,r2		;name is 4 words long
	mov	r3,r1		;copy ptr
	mov	(sp),r0		;point at name
30$:	cmp	(r0)+,(r1)+	;do they match?
	bne	40$		;no, skip
	sob	r2,30$		;loop
	br	60$		;got it
40$:	add	#100,r3		;point at next entry in block
	sob	r4,20$		;check the whole block
	sob	r5,10$		;for all blocks
50$:	; losername not found
	tst	(sp)+		;clear stack
	call	close1		;close the file
	sec			;error
	rts	pc
60$:	mov	xrb+10,r2	;save block
	tst	(sp)+		;clear stack
	call	close1		;close the file
	clc			;no error
	rts	pc
70$:	type	usrerr		;error opening loser list
	exit$s
;+
;
; Open a file for output.
; If the file is in use, wait 3 secs and retry.
;
; On entry:
;  r2	-> .word PPN ? .rad50 /FILNAMEXT/ ? .word dev,<flag,,unit>
;
; On return, C=1 if error opening file,
; else file is open on channel 1.
;
;-
openw:	call	clrfrq		;zap the firqb
	movb	#opnfq,firqb+3	;func=open for output
	movb	#2,firqb+4	;channel 1
	mov	#firqb+6,r1	;point
	mov	(r2)+,(r1)+	;PPN
	mov	(r2)+,(r1)+	;FIL
	mov	(r2)+,(r1)+	;NAM
	mov	(r2)+,(r1)	;.EXT
	mov	(r2)+,firqb+30	;dev
	mov	(r2),firqb+32	;flag, unit
	calfip			;open the file
	mov	firqb,r0	;error?
	bne	10$		;yep, bag
	bit	#2000,firqb+24	;do we have write access?
	beq	20$		;yep, good
	call	close1		;no, close it
	mov	#3,xrb		;wait 3 seconds
	.sleep
	sub	#12,r2		;back up again
	br	openw		;try again...
10$:	sec			;error opening file (code in r0)
	rts	pc
20$:	clc			;no problem
	rts	pc
;
close1:	; close channel 1
	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#2,firqb+4	;channel 1
	calfip			;do it
	rts	pc
;
clrfrq:	; clear the firqb
	mov	#firqb,r0	;point at firqb
	mov	#20,r1		;length
10$:	clr	(r0)+		;clear out the firqb
	sob	r1,10$		;loop
	rts	pc
;+
;
; Put .RAD50 losername at (r0) in buf at (r5).
;
;-
pr50:	call	pr50a		;do 3 chars
	call	pr50a
	call	pr50a
	;br	pr50a
pr50a:	; do 3 chars
	mov	(r0)+,r3	;get a word
	clr	r2		;SXT
	div	#50,r2		;/50
	mov	r3,r4		;copy rem
	mov	r2,r3		;copy quo
	clr	r2		;SXT
	div	#50,r2		;/50
	movb	rad50(r2),(r5)+	;first byte
	bne	10$		;not null
	dec	r5		;bag it
10$:	movb	rad50(r3),(r5)+	;2nd byte
	bne	20$		;not null
	dec	r5		;bag it
20$:	movb	rad50(r4),(r5)+	;3rd byte
	bne	30$		;not null
	dec	r5		;bag
30$:	rts	pc
;+
;
; Convert a string to radix-50.
; On entry, r0 points to an ASCIZ string,
; r5 points to the area in which to store the result.
;
; On return, C=1 if the string contained non-rad50 chars.
;
;-
cvr50:	mov	r0,r2		;copy ptr
	mov	r0,r4		;twice
10$:	movb	(r0)+,r3	;get a char
	beq	30$		;end, skip
	cmp	r3,#40		;blank or tab?
	blos	10$		;yes, ignore
	cmp	r3,#'a		;lower case?
	blo	20$
	cmp	r3,#'z
	bhi	20$
	bic	#40,r3		;yes, convert
20$:	movb	r3,(r2)+	;put in buf
	br	10$		;loop
30$:	clrb	(r2)		;mark end in case of error later
	mov	r4,r0		;copy ptr
	sub	r0,r2		;find length
	mov	r2,r1		;copy
	mov	#4,r4		;4 words
40$:	clr	r3		;init
	jsr	pc,60$		;do 3 chars
	jsr	pc,50$
	jsr	pc,50$
	mov	r3,(r5)+	;save
	sob	r4,40$		;loop
	rts	pc
;
50$:	; do a single char
	mul	#50,r3		;make space for the char
60$:	tst	r1		;anything left?
	beq	120$		;no, return
	dec	r1		;yes, dec count
	movb	(r0)+,r2	;and get the char
	cmp	#'$,r2		;dollar sign?
	bne	70$		;no
	add	#33,r3		;yes
	rts	pc
70$:	cmp	#'_,r2		;underline?
	bne	80$		;no
	add	#35,r3		;yes, use undefined code
	rts	pc
80$:	cmp	#'.,r2		;decimal point?
	beq	90$		;yes
	cmp	r2,#'0		;digit?
	blo	100$		;no
	cmp	r2,#'9		;hm?
	bhi	100$		;no
90$:	add	#36-'0,r2	;yes, convert to rad50
	br	110$		;skip
100$:	sub	#'A,r2		;letter?
	blo	130$		;no
	cmp	r2,#25.		;hm?
	bhi	130$		;no
	inc	r2		;yes, convert to rad50
110$:	add	r2,r3		;add in
120$:	rts	pc
130$:	tst	(sp)+		;purge stack
	sec			;error
	rts	pc		;fall through to original caller
;+
;
; Copy an ASCIZ string into the buffer at (r5).
; Takes ptr to string in r0.
;
;-
copy:	movb	(r0)+,(r5)+	;copy
	bne	copy		;loop
	dec	r5		;bag the nul
	rts	pc
;+
;
; Add a CRLF to the buffer at (r5).
;
;-
crlf:	movb	#cr,(r5)+	;cr
	movb	#lf,(r5)+	;lf
	rts	pc
;+
;
; Print a string on the terminal.
;
; Call:
;	jsr	r5,print
;	.word	len,addr
;
;-
print:	mov	#xrb,r0		;point at xrb
	mov	(r5),(r0)+	;len
	mov	(r5)+,(r0)+	;... twice
	mov	(r5)+,(r0)+	;addr
	clr	(r0)+		;channel 0
	clr	(r0)+		;next block
	clr	(r0)+		;(not used)
	clr	(r0)		;no modifiers
	.write			;print it
	rts	r5
;+
;
; Read a line from the terminal into (r0).
; Remove delimiter(s), return ptr in r0,
; length in r1, delimiter in r2.
;
; Return C=1 if end of file.
;
;-
rdline:	mov	#xrb,r1		;point at xrb
	mov	#kbbufl,(r1)+	;length
	clr	(r1)+		;nothing read yet
	mov	r0,(r1)+	;addr
	clr	(r1)+		;channel 0
	clr	(r1)+		;next block
	clr	(r1)+		;unlimited KB wait
	clr	(r1)		;no modifiers
	.read			;get it
	tstb	firqb		;any problems?
	bne	20$		;yep, ^Z or something
	mov	xrb+2,r1	;get # bytes read
	add	r0,r1		;point at end
	movb	-(r1),r2	;back up, get delimiter
	cmpb	-(r1),#cr	;cr?
	beq	10$		;yes
	inc	r1		;no, skip it
10$:	clrb	(r1)		;mark end
	sub	r0,r1		;find length (C=0)
	rts	pc
20$:	sec			;^Z
	rts	pc
	exit$s			;die
;
usrlst:	.word	bbsppn		;[p,pn]
	.rad50	/BBUSERDAT/	;BBUSER.DAT
	.word	bbsdev,bbsunt	;_devn:
;
mailfi:	.word	bbsppn		;[p,pn]
	.rad50	/BBMAILDAT/	;BBMAIL.DAT
	.word	bbsdev,bbsunt	;_devn:
;
rad50:	.ascii	<0>'ABCDEFGHIJKLMNOPQRSTUVWXYZ$._0123456789'
;
from:	.asciz	'From: '
;
subj:	.asciz	'Subject: '	;subject prompt
l.subj=	.-subj-1
;
date:	.asciz	'Date: '
;
inrep2:	.asciz	'In-reply-to: Your msg of '
;
to:	.asciz	'To: '
l.to=	.-to-1
;
msg:	.ascii	'Msg: (end with escape or ^Z)'<cr><lf>
l.msg=	.-msg
;
queued:	.asciz	'Queued: '
;
lastln:	.ascii	<bell>'%This is your last line'<cr><lf>
l.last=	.-lastln
;
usrerr:	.ascii	<cr><lf>"?READ-U-Unable to obtain user list"<cr><lf>
l.usre=	.-usrerr
;
subk:	.asciz	'subject'	;keywords to parse off of msg
datek:	.asciz	'date'
fromk:	.asciz	'from'
;
anon:	.ascii	"Anonymous users can't receive mail."<cr><lf>
	.ascii	"Type USERNAME to get a life."<cr><lf><lf>
l.anon=	.-anon
;
nomail:	.ascii	"No mail for "
l.noma=	.-nomail
;
replyq:	.ascii	"(A)gain/(R)eply/(N)ext <N>? "
l.repl=	.-replyq
;
what:	.ascii	"?Huh?"<cr><lf><lf>
l.what=	.-what
;
noret:	.ascii	"?No return address"<cr><lf><lf>
l.nore=	.-noret
;
badadr:	.ascii	"?Bad address: "
l.bada=	.-badadr
;
nosuch:	.ascii	"?The recipient does not exist"<cr><lf><lf>
l.nosu=	.-nosuch
;
nomore:	.ascii	"No more mail"<cr><lf><lf>
l.nomo=	.-nomore
;
crlfs:	.byte	cr,lf
l.crlf=	.-crlfs
	.byte	lf
;
	.even
blk:	.word			;block # of rcpt loser list entry
addr:	.word			;offset +#buf
;
usrppn:	.word			;loser's PPN, or 0 if mail goes to BBMAIL.DAT
flag:	.word			;buffer used while scanning mail file
;
kbbufl=	82.
sbjct:	.blkb	kbbufl		;'Subject' buffer
datbuf:	.blkb	kbbufl		;'Date' buffer
kbbuf:	.blkb	kbbufl		;random KB buffer
;
name:	.blkb	12.		;losername (ASCII)
timdat:	.blkw	2		;time, date of last login
loser:	.blkw	4		;loser's name (.RAD50)
;
rcpt:	.blkw	4		;recipient losername
numblk:	.word			;# blks in msg (including rcpt)
buf:	.blkw	1000		;whatever
bufend:
;
	.end	read