.enabl	lc
	.title	BBS11
	.ident	/V1/
;+
;
; Keyboard monitor for Digby's Bitpile.
; Runs as an RTS for better ^C and error trapping
; (don't want them running amok on the system!).
;
; By John Wilson, 17-Sep-85.
;
; To build:
; MACRO BBS=PREFIX,BBS
; LINK BBS,BBS,BBS=BBS/H:177776
; RUN $SILUS
; BBS.RTS,BBS=BBS
; ^Z
; PIP SY0:[0,1]=BBS.RTS
; UTILTY ADD BBS
;
;-
	.dsabl	gbl	;in case assembled with MAC
;
firqb=	402	;file request queue block
xrb=	442	;transfer request
corcmn=	460	;core common area
;
ctrlc=	3	;^C
ctrld=	4	;^D
tab=	11	;tab
lf=	12	;line feed
ff=	14	;form feed
cr=	15	;carriage return
esc=	33	;escape
blank=	40	;space
;
calfip=	emt	;call file processor
opnfq=	2	;CALFIP subfunc to open a file
errfq=	16	;subfunc to return error message
rstfq=	20	;subfunc to reset channel(s)
.read=	emt+2	;read a record
.write=	emt+4	;write a record
.ttrst=	emt+26	;cancel ctrl/o effect
.postn=	emt+32	;get carriage posn
.date=	emt+34	;get system date/time
.run=	emt+42	;chain to a program
.name=	emt+44	;set name for SYSTAT
.exit=	emt+46	;bomb out to BASIC
.ccl=	emt+62	;execute concise command language command
.uuo=	emt+66	;FIP
uu.cnv=	20.	;FIP func to convert date and time to ASCII
;
buf=	1000	;buffer
;
rtsbas::	;base of RTS, for length calculation at P.OFF
;+
;
; KBM entry point.
; Open KB: mode 16 so we can defend ourself.
;
;-
kbm::	mov	#400,sp 	;set up stack
	mov	#^RKBM,firqb+10	;set name to 'KBM   '
	clr	firqb+12
	.name			;do it
	movb	#rstfq,firqb+3	;func=reset
	clrb	firqb+4		;all channels
	calfip			;(in case any were left open)
	mov	#firqb,r0	;point at firqb
	mov	#20,r1		;length
10$:	clr	(r0)+		;clear it out
	sob	r1,10$		;loop
	movb	#opnfq,firqb+3	;OPEN
	mov	#"KB,firqb+30	;'_KB:'
	movb	#2,firqb+4	;AS FILE 1%,
	mov	#100020,firqb+22 ;MODE 16%
	calfip			;do it
	tstb	firqb		;how'd it go?
	beq	cmd		;OK, skip
	jmp	kill		;kill job on error
;+
;
; Read a command from the keyboard and process it.
; Allow abbreviations down to two characters.
;
; On entry:
;	r0=ptr to current posn in command line
;	r2=ptr to list of return values
;	r3=ptr to table of keyword names
;	r4=number of keywords in list
;
;-
cmd:	.ttrst			;cancel ^O or ^C effect
	jsr	r5,type		;print prompt
	.word	l.prom,prompt	;in-line args
cmd1:	mov	#xrb,r5		;point at xrb
	mov	#82.,(r5)+	;80 chars +crlf
	clr	(r5)+		;none yet
	mov	#corcmn+1,r0	;point at core common area
	mov	r0,(r5)+
	mov	#2,(r5)+	;channel 1
	clr	(r5)+		;next block
	mov	#5*60.,(r5)+	;wait up to 5 minutes
	clr	(r5)		;no modifiers
	.read			;go for it
	movb	firqb,r5	;any errors?
	beq	20$		;no, continue
	cmp	r5,#11.		;'?End of file on device'?
	bne	10$		;no, skip
	clrb	corcmn		;clear core common
5$:	mov	#bye+2,r0	;point at .RUN block
	jmp	chain		;(equivalent to 'BYE')
10$:	cmp	r5,#15.		;'?Keyboard wait exhausted'?
	bne	15$		;no
	jsr	r5,type		;print message
	.word	l.timo,timout
	mov	#'Y*400+1,corcmn ;set core common to 'Y'
	br	5$		;BYE Y
15$:	jmp	kill		;otherwise kill this job
20$:	movb	#2,xrb+6	;channel 1%
	.postn			;get carriage position
	tstb	xrb+2		;at left margin?
	beq	30$		;yes, skip
	jsr	r5,type		;no, crlf
	.word	2,crlf
30$:	mov	#corcmn+1,r0	;pt at line
	mov	#cmdptr,r2	;pt at vectors
	mov	#cmdtab,r3	;pt at commands
	mov	#numcmd,r4	;# of cmds
40$:	movb	(r0)+,r1	;get a char
	beq	cmd		;nothing there, never mind
	cmp	r1,#blank	;space?
	beq	40$		;yes, ignore
	cmp	r1,#tab		;tab?
	beq	40$		;yes
	cmp	r1,#cr		;delimiter?
	beq	cmd		;yes, ignore
	cmp	r1,#ff		;form feed?
	beq	cmd1		;don't prompt
	cmp	r1,#lf
	beq	cmd
	cmp	r1,#esc
	beq	cmd
	cmp	r1,#ctrld
	beq	cmd
	cmp	r1,#ctrlc	;^C?
	bne	50$		;no, skip
	.ttrst			;turn output back on
	br	cmd		;don't prompt again
50$:	dec	r0		;dec ptr
60$:	mov	r0,r5		;point at beginning of command
70$:	movb	(r5)+,r1	;get char
	cmp	r1,#blank	;space or tab or ff or nul?
	blos	match		;yes, this is a match
	cmp	r1,#'/		;slash?  (switch)
	beq	match		;yes, this is a match
	tstb	(r3)		;end of string?
	beq	90$		;yes, first string should have ended
	cmp	r1,#'a		;lower case?
	blo	80$		;no
	cmp	r1,#'z		;eh?
	bhi	80$		;no, definitely not
	sub	#40,r1		;cvt to upper case
80$:	cmpb	r1,(r3)+	;compare two chars
	beq	70$		;loop if same
90$:	tstb	(r3)+		;skip to begn of next name
	bne	90$		;loop if not at end
	tst	(r2)+		;skip over an address
	sob	r4,60$		;loop until all keywords checked
gack:	jsr	r5,type		;no match, gack
	.word	l.illc,illcmd
	br	cmd		;loop
match:	; got a match
	dec	r5		;pt at space (or whatever)
	mov	r5,r4		;copy
	sub	r0,r4		;find length
	cmp	r4,#2		;at least 2 chars?
	blo	gack		;no, complain
	mov	#corcmn+1,r1	;point at core common
	clr	r3		;init count
10$:	movb	(r5)+,r0	;get a char
	beq	20$		;end of line
	cmp	r0,#ctrlc	;^C at end?
	bne	11$		;no, skip
	jmp	cmd		;yes, never mind
11$:	cmp	r0,#ctrld	;delimiter?
	beq	20$		;exit loop if so
	cmp	r0,#lf
	beq	20$
	cmp	r0,#ff
	beq	20$
	cmp	r0,#cr
	beq	20$
	cmp	r0,#esc
	beq	20$
	inc	r3		;otherwise bump length
	movb	r0,(r1)+	;put in buffer
	br	10$		;loop
20$:	movb	r3,@#corcmn	;save length for SYS(CHR$(7%))
	mov	(r2),r0		;get pointer
	jmp	@(r0)+		;jump to routine
;+
;
; Routine to type a string
; on channel 1.
; Must be called through r5,
; with the address and length
; in-line.
;
;-
type:	mov	(r5),xrb	;len
	mov	(r5)+,xrb+2	;(twice)
type1:	mov	(r5)+,xrb+4	;addr
	mov	#2,xrb+6	;channel 1
	clr	xrb+10		;next block
	clr	xrb+14		;no modifiers
	.write			;do it
	tstb	firqb		;did they hang up?
	bne	10$		;yes, kill our job
	rts	r5		;no
10$:	jmp	kill		;buy it
;
chain:	; chain to a program
	mov	(r0)+,firqb+30	;device
	mov	(r0)+,firqb+32	;unit
	mov	(r0)+,firqb+6	;ppn
	mov	(r0)+,firqb+10	;filename
	mov	(r0)+,firqb+12
	mov	(r0)+,firqb+14	;extension
	mov	(r0)+,firqb+36	;BASIC+ line #
	.run			;try to chain to it
	jsr	r5,type		;print message
	.word	l.rune,runerr
	jmp	cmd		;loop
;
badwrd:	; respond to bad language
	cmp	r4,#4		;got all 4 chars?
	blo	gack		;no, could be something else
	jsr	r5,type		;otherwise answer them
	.word	l.curs,curse
	jmp	cmd		;loop
;
ccl:	; execute CCL command
	mov	#buf,r5		;point at buffer
	mov	r5,xrb+4	;address of CCL cmd
	mov	r3,r4		;init length
10$:	movb	(r0)+,(r5)+	;copy CCL name
	beq	20$		;done, skip
	inc	r4		;bump length
	br	10$		;loop
20$:	dec	r5		;back up
	tst	r3		;were there any parameters?
	beq	50$		;no
	mov	#corcmn+1,r0	;yes, point at them
	clr	r2		;clear switch flag
30$:	movb	(r0)+,r1	;get a byte
	tst	r2		;flag set?
	bne	40$		;yes
	cmp	r1,#blank	;blank or ctrl char?
	blos	40$		;yes, skip
	cmp	r1,#'/		;switch?
	bne	60$		;no, error
	com	r2		;yes, set flag
40$:	movb	r1,(r5)+	;copy
	sob	r3,30$		;loop
50$:	mov	r4,xrb		;set length
	mov	r4,xrb+2	;twice
	.ccl			;call the program
	jmp	cmd		;bombed, ignore the error
60$:	jsr	r5,type		;print message
	.word	l.swer,swerr
	jmp	cmd
;
prtim:	; print time and date
	.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 format
	.uuo			;convert date/time to ASCII
	mov	#buf,r0		;point at buffer
	mov	#firqb+26,r1	;point at time
10$:	movb	(r1)+,(r0)+	;copy a byte
	bne	10$		;loop
	dec	r0		;back up
	movb	#',,(r0)+	;add ', '
	movb	#' ,(r0)+
	mov	#firqb+10,r1	;point at date
20$:	movb	(r1)+,(r0)+	;copy
	bne	20$		;loop
	sub	#buf+1,r0	;correct for nul & find length
	mov	r0,xrb		;put in xrb
	mov	r0,xrb+2	;...
	jsr	r5,type1	;print date, time
	.word	buf
	jsr	r5,type		;cr/lf
	.word	2,crlf
	jmp	cmd		;loop
;
vrsion:	; give them our version number
	jsr	r5,type		;print it
	.word	l.vers,versn
	movb	#errfq,firqb+3	;func=return error message
	clrb	firqb+4		;error 0
	calfip			;get error message
	mov	#firqb+40,r0	;point at end of message
10$:	tstb	-(r0)		;strip off trailing nulls
	beq	10$		;whee!
	sub	#firqb+3,r0	;correct, and convert to length
	mov	r0,xrb		;put in xrb
	mov	r0,xrb+2
	jsr	r5,type1	;print system ID
	.word	firqb+4		;addr of error message
	jsr	r5,type		;crlflf
	.word	3,crlf
	jmp	cmd		;loop
;
typinf:	; print info file
	clrb	firqb+3		;(=CLSFQ) close channel 2
	movb	#4,firqb+4	;in case it was open previously
	calfip			;(they ^Ced, or whatever)
	mov	#firqb,r0	;point at firqb
	mov	#20,r1		;length
1$:	clr	(r0)+		;zap a word
	sob	r1,1$		;loop
	movb	#opnfq,firqb+3	;open the file
	movb	#4,firqb+4	;channel 2
	mov	#firqb+6,r0	;point at filespec
	mov	#bbsppn,(r0)+	;ppn
	mov	#^RINF,(r0)+	;filename='INFO.TXT'
	mov	#^RO  ,(r0)+
	mov	#^RTXT,(r0)+
	mov	#120000,firqb+22 ;/RONLY
.iif ne <bbsdev>, mov #bbsdev,firqb+30
.iif ne <bbsunt>, mov #bbsunt,firqb+32
	calfip			;do it
	mov	firqb+16,r5	;get file size
10$:	mov	#xrb,r0		;point at xrb
	mov	#1000,(r0)+	;read one block
	clr	(r0)+		;nothing read yet
	mov	#buf,(r0)+	;read into buf
	mov	#4,(r0)+	;channel 2
	clr	(r0)+		;next block
	clr	(r0)+		;n. a.
	clr	(r0)		;no modifiers
	.read			;read a block
	mov	#buf+1000,r0	;pt at end of buffer
20$:	tstb	-(r0)		;trim trailing nuls
	beq	20$
	inc	r0		;found non-nul char
	sub	#buf,r0		;find length
	mov	r0,xrb		;set up xrb
	mov	r0,xrb+2
	jsr	r5,type1	;type it out
	.word	buf
	sob	r5,10$		;for all blocks
	clrb	firqb+3		;(=CLSFQ) func=close
	movb	#4,firqb+4	;channel 2
	calfip
	jmp	cmd		;loop
;
; They hung up.  Kill the job.
;
kill:	.exit	;;;;; for now
;
; Here on unlikely or impossible event.
; Jumps here on P.NEW, P.RUN, or any system
; trap (these are of course impossible)
; (just watch me).  Print a message and buy it.
;
norun:	mov	#xrb,r0		;point at xrb
	mov	#l.nrun,(r0)+	;length
	mov	#l.nrun,(r0)+	;...
	mov	#nrun,(r0)+	;addr
	clr	(r0)+		;channel 0%
	clr	(r0)+		;next block
	clr	(r0)+		;(not applicable)
	clr	(r0)		;no modifiers
	.write			;do it
	.exit			;back to BASIC
;
prompt:	.ascii	/@/
l.prom=	.-prompt
;
crlf:	.byte	cr,lf,lf	;extra lf used by VRSION
;
illcmd:	.ascii	/?I beg your pardon?/<cr><lf>
l.illc=	.-illcmd
;
curse:	.ascii	/Tough shit, asshole!/<cr><lf>
l.curs=	.-curse
;
runerr:	.ascii	/?Error in .RUN - punt!/<cr><lf>
l.rune=	.-runerr
;
swerr:	.ascii	/?Output to KB: only, my child/<cr><lf>
l.swer=	.-swerr
;
timout:	.ascii	<cr><lf><7>/?Keyboard timeout - see you around/<cr><lf>
l.timo=	.-timout
;
versn:	.ascii	<lf>/BBS-11 V1; /
l.vers=	.-versn
;
nrun:	.ascii	<cr><lf>/?BBS.RTS cannot .RUN programs/<cr><lf>
l.nrun=	.-nrun
;
cmdtab:	.asciz	/BYE/		;log off
	.asciz	/CONFERENCE/	;*FORUM?  hmmm...
	.asciz	/DAMN/		;yep
	.asciz	/FILES/		;upload/download various goodies
	.asciz	/FUCK/		;we should give some kind of response to this
	.asciz	/GAMES/		;GAMES:LIST.BAC
	.asciz	/HELP/		;help on commands
	.asciz	/INFO/		;background information
	.asciz	/KJOB/		;kill job
	.asciz	/LOGOUT/	;logout
	.asciz	/MAIL/		;send mail
	.asciz	/PASSWORD/	;change password
	.asciz	/READ/		;read mail
	.asciz	/SHIT/		;trap bad words
	.asciz	/SYSTAT/	;&SYSTAT.BAC
	.asciz	/TIME/		;print time and date
	.asciz	/USERNAME/	;create a username
	.asciz	/VERSION/	;print BBS.RTS version
;
	.even
cmdptr:	.word	bye
	.word	conf
	.word	swear
	.word	files
	.word	swear
	.word	games
	.word	help
	.word	info
	.word	bye
	.word	bye
	.word	mail
	.word	paswrd
	.word	read
	.word	swear
	.word	systat
	.word	time
	.word	usrnam
	.word	ver
numcmd=	<.-cmdptr>/2
;
bye:	.word	chain
	.word	bbsdev,bbsunt,bbsppn ;CHAIN 'devn:[p,pn]HANGUP.TSK' LINE 0%
	.rad50	/HANGUPTSK/
	.word	0
;
conf:	.word	chain
	.word	bbsdev,bbsunt,bbsppn ;CHAIN 'devn:[p,pn]CONFER.TSK' LINE 0%
	.rad50	/CONFERTSK/
	.word	0
;
swear:	.word	badwrd
;
files:	.word	chain
	.word	bbsdev,bbsunt,bbsppn ;CHAIN 'devn:[p,pn]FILES.TSK' LINE 0%
	.rad50	/FILES TSK/
	.word	0
;
games:	.word	chain
	.word	0		;CHAIN 'SY:[10,2]LIST.BAC' LINE 0%
	.word	0
	.byte	2,10.
	.rad50	/LIST  BAC/
	.word	0
;
help:	.word	chain
	.word	bbsdev,bbsunt,bbsppn ;CHAIN 'devn:[p,pn]HELP.BAC' LINE 0%
	.rad50	/HELP  BAC/
	.word	0
;
info:	.word	typinf		;PIP devn:[p,pn]INFO.TXT
;
mail:	.word	chain
	.word	bbsdev,bbsunt,bbsppn ;CHAIN 'devn:[p,pn]BBMAIL.TSK'
	.rad50	/BBMAILTSK/
	.word	0
;
paswrd:	.word	chain
	.word	bbsdev,bbsunt,bbsppn ;CHAIN 'devn:[p,pn]PASWRD.TSK'
	.rad50	/PASWRDTSK/
	.word	0
;
read:	.word	chain
	.word	bbsdev,bbsunt,bbsppn ;CHAIN 'devn:[p,pn]BBREAD.TSK'
	.rad50	/BBREADTSK/
	.word	0
;
systat:	.word	ccl
	.asciz	/SYSTAT/	;SYSTAT
	.even
;
time:	.word	prtim		;print time and date
;
usrnam:	.word	chain
	.word	bbsdev,bbsunt,bbsppn ;CHAIN 'devn:[p,pn]USRNAM.TSK'
	.rad50	/USRNAMTSK/
	.word	0
;
ver:	.word	vrsion		;print version
;
; Fill out to next multiple of 2kw.
;
fill=	.-rtsbas+3777&^C3777	;round up to 2kw
.if ge <fill-46>-<.-rtsbas>	;space at end of page for vectors
 fill=	fill-46
.iff				;no space, add a new page
 fill=	fill+3732
.endc
	.=rtsbas+fill		;(p.off=177732)
;
; RTS description and vector area.
;
p.off::	.byte	0,^B00001001	;P.FLAG: set PF.NER and PF.KBM
	.rad50	"DGB"		;P.DEXT: default extension
	.word	0		;P.ISIZ: (reserved for future incompatibility)
	.word	1		;P.MSIZ: minimum possible minimum
	.word	norun		;P.FIS:  we can't do .RUN anyway
	.word	norun		;P.CRAS: we aren't the primary RTS
	.word	norun		;P.STRT: same as above
	.word	kbm		;P.NEW:  start new user
	.word	norun		;P.RUN:  but we don't do .RUNs!
	.word	norun		;P.BAD:  can't happen if we don't .RUN
	.word	norun		;P.BPT:  same as above
	.word	norun		;P.IOT:  ...
	.word	norun		;P.EMT:
	.word	norun		;P.TRAP:
	.word	norun		;P.FPP:
	.word	kbm		;P.CC:   ^C vector
	.word	kbm		;P.2CC:  ^^C vector
	.word	1		;P.SIZE: minimum possible maximum
;
	.end