title cmd

a=1
b=2
c=3
d=4
e=5
t=6
tt=7

x=14
y=15
z=16
p=17

ttyo==1
dski==2

jcllen==20.
cmdlen==100.
pdllen==50.
buflen==1000.

define princ &string&
	movei y,.length string
	move x,[440700,,[ascii string]]
	.call cprinc
	 .lose %lsfil
termin

define tyo loc
	.iot ttyo,loc
termin

define terpri
	.iot ttyo,[^M]
	.iot ttyo,[^J]
termin

call=pushj p,
return=popj p,

.vector pdl(pdllen)
.scalar uname,xuname,jname,xjname,sname,hsname

go:	move p,[-pdllen,,pdl-1]
	.call [setz ? sixbit /open/
		move [.uao,,ttyo]
		setz [sixbit /tty/]]
	 .lose %lssys
	.suset [-6,,[	.runame,,uname
			.rxuname,,xuname
			.rjname,,xjname
			.rxjname,,xjname
			.rsname,,sname
			.rhsname,,hsname]]			
	.call [setz ? sixbit /open/
		move [.uai,,dski]
		move [sixbit /dsk/]
		move xuname
		move [sixbit /(cmds)/]
		setz hsname]
	 jrst [	princ /No command file?/
		jrst die]

	setzi c,
	move a,xjname
	jumpe a,rcmdl0
rcmdlp:	setzi b,
	rotc a,6
	addi b,40
	movem b,cmd(c)
	aoj c,
	jumpn a,rcmdlp
rcmdl0:	setzm cmd(c)

	.suset [.roption,,a]
	tlne a,%opcmd
	 jrst rjcl
	jrst search
	
rjcl:	.break 12,[..rjcl,,jclbuf]
	move a,[440700,,jclbuf]

	move b,xjname
	came b,[sixbit/cmd/]
	 jrst jclall
	setzi c,
rjcl1:	ildb b,a
	cail b,"a
	 caile b,"z
	  skipa
	   subi b,"a-"A
	caig b,40
	 jrst jclrst
	movem b,cmd(c)
	aoja c,rjcl1

jclall: movei b,40
	movem b,cmd(c)
	aoj c,
	ildb b,a

jclrst:	caie b,^C
	 cain b,^M
	  skipa
	   cain b,^_
	    jrst jclend
	movem b,cmd(c)
	ildb b,a
	aoja c,jclrst	

jclend:	setzm cmd(c)

.vector cmd(cmdlen)

search:	setzi a,		;no first character.
	call fndsig		;find a significant character
searc1:	call fndtok		;find a token
	call fndmat		;try to find a match
	 jrst [	call pnttok	;punt the current token
		jrst searc1 ]	;try next token
	call fndeol		;find eol
	call pnteol		;and punt it

.vector buffer(buflen)

	move  [ascii /:kil/]
	movem buffer
	move  [asciz /l /]
	movem buffer+1
	move b,[170700,,buffer+1]
copy:	jumpl a,gotit		;EOF
	cain a,^_		;EOR
	 jrst gotit
	idpb a,b
	.iot dski,a
	jrst copy

gotit:	setzi 
	idpb  b
	.value buffer
	.value [asciz /:HUH?  This can't happen!/]



define key name,routine,args
	asciz /name/,,[routine,,args]
termin

;;; comtbl:	key	uname,	ins6,	uname
;;; 	key	xuname,	ins6,	xuname
;;; 	key	jname,	ins6,	jname
;;; 	key	xjname,	ins6,	xjname
;;; 	key	sname,	ins6,	sname
;;; 	key	hsname,	ins6,	hsname
;;; 	key	cname,	inscnm
;;; 	key	jcl,	insjcl
;;; 	key	rstjcl,	insrjc
;;; 	key	atom,	insatm
;;; 	key	squoze,	inssqz
;;; 	0,,0


fndsig:	call skpsig
	 skipa			;insig
	  return		;sig
	.iot dski,a
	jumpge a,fndsig
	jrst fail

fndeol:	caie a,^M
	 cain a,^J
	  return
	.iot dski,a
	jumpge a,fndeol
	jrst fail		;EOF

fndeor:	cain a,^_
	 return
	.iot dski,a
	jumpge a,fndeor
	jrst fail		;EOF

pnteor:	cain a,^_
	 .iot dski,a
	return

fndtok:	call skpsig		;is it a significant character?
	 skipa			;nope, do some other checks
	  return
	call skpeol		;is it an end of line character?
	 skipa			;nope, it is really insig
	  jrst fndto2
	.iot dski,a
	jumpge a,fndtok
	jrst fail

fndto2:				;eol found
	call fndeor		;go find end of record
	call pnteor		;and punt it
	jrst fndsig		;and go find a significant character

fndmat:	setzi b,
fndma1:	move c,cmd(b)
	caig c,40
	 jrst fndma7
	cail a,"a
	 caile a,"z
	  skipa
	   subi a,"a-"A
	came a,c
	 return			;no match, so return
	.iot dski,a
	jumpl a,fail		;EOF
	aoja b,fndma1

fndma7:	call skpsig
	 jrst cpopj1		;match if insig
	return			;no match if sig

skpsig:	caie a,40
	 cain a,^I
	  popj p,
	caie a,^J
	 cain a,^M
	  popj p,
	skiple a		;catches ^@ and EOF
cpopj1:	 aos (p)
cpopj:	popj p,

skpeol:	caie a,^M
	 cain a,^J
	  aos (p)
	   return

pnteol:	call skpeol
	 return
	.iot dski,a
	jrst pnteol

pnttok:	call skpsig
	 return
	.iot dski,a
	jrst pnttok

fail:	princ /Command "/
	setzi b,
fail0:	skipn a,cmd(b)
	 jrst fail1
	tyo a
	aoja b,fail0

fail1:	princ /" not found/
die:	skipe debug
	 .value
	.break 16,164000
	.value [asciz /:HUH?  This can't happen!/]

cprinc:	setz
	sixbit /siot/
	movei ttyo
	move x
	setz y

constants

debug:	0			;-1 => debugging

jclbuf:	block jcllen
	-1

variables

	end go

;;; local modes:
;;; mode:midas
;;; auto fill mode:
;;; fill column: 70
;;; compile command: :midas dcp;ts cmd_1 î
;;; end: